Wild Card Game Analysis
davegoblue
2023-01-15
Introduction
This file explores card games that use a standard 52-card deck, optionally modified so that one or more cards are wild, as follows:
- One or more jokers may be added (the card has no natural rank or
suit but may take on the most favorable)
- One or more natural cards may also be used as a wild (in deuces wild, the deuce has a natural suit and rank and can also take on the suit and rank of a more favorable card)
The analysis treats cards 1-52 as being the standard deck, with suits being 1-13, 14-26, 27-39, and 40-52. Counting the first card of each suit as 1, ranks are 1=Ace, 2-10=same card as value, 11=Jack, 12=Queen, 13=King. The Ace almost always plays as the highest rank, but can be treated as low for making a 5432A straight
Methodology
Basic Parameters
Several basic parameters of the game are established:
library(tidyverse) # tidyverse functionality is included throughout## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.0 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.1 ✔ tibble 3.1.8
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the ]8;;http://conflicted.r-lib.org/conflicted package]8;; to force all conflicts to become errorssource("./Generic_Added_Utility_Functions_202105_v001.R") # Basic functions
nCards <- 53 # This is a standard 52-card deck with a joker
nRanks <- 13 # There are 13 ranks A, 2-10, J, Q, K
nSuits <- 4 # There are four suits, each of 13 cards
perHand <- 5 # Number of cards drawn per hand
idxWild <- c(2, 15, 28, 41, 53) # The indices of the cards that can be considered wild (deuces and the joker)
# Check alignment of basic parameters
if(nSuits*nRanks > nCards) stop("\nerror, misaligned parameters for number of ranks, suits, and cards\n")
if(!isTRUE(setdiff(1:nCards, 1:(nRanks*nSuits)) %in% idxWild %>% reduce(.f=`&`)))
stop("\nError, any cards outside the standard nRanks*nSuits must be included in idxWild\n")
# Announce the number of wild cards
cat("\nThe game will be played with a", nCards, "card deck with", length(idxWild), "cards considered wild")##
## The game will be played with a 53 card deck with 5 cards considered wildcat("\nWild cards are of indices", paste0(idxWild, collapse=", "))##
## Wild cards are of indices 2, 15, 28, 41, 53# Announce any cards of no suit or rank
if(!isTRUE(idxWild %in% 1:(nRanks*nSuits) %>% reduce(.f=`&`))) {
cat("\nWilds with no natural rank or suit at indices:",
paste0(idxWild[!(idxWild %in% 1:(nRanks*nSuits))], collapse=",")
)
} else cat("\nAll wilds have a natural suit and rank")##
## Wilds with no natural rank or suit at indices: 53# Announce wilds with natural ranks and suits
if(isTRUE(idxWild %in% 1:(nRanks*nSuits) %>% reduce(.f=`|`))) {
tmpIdxWild <- idxWild[idxWild %in% 1:(nRanks*nSuits)]
cat("\nWilds with natural rank and suit at indices:", paste0(tmpIdxWild, collapse=", "))
cat("\nThese are of suit-independent rank", paste0((tmpIdxWild-1)%%nRanks+1, collapse=", "), "\n")
} else cat("\nNo wilds have a natural suit and rank\n")##
## Wilds with natural rank and suit at indices: 2, 15, 28, 41
## These are of suit-independent rank 2, 2, 2, 2All choose(nCards, perHand) combinations of hands are created based on index:
startTime <- proc.time()
# Create a matrix of all possible hand indices
mtxHands <- t(combn(1:nCards, perHand))
str(mtxHands)## int [1:2869685, 1:5] 1 1 1 1 1 1 1 1 1 1 ...proc.time() - startTime## user system elapsed
## 3.39 0.08 4.14Hands are scored for their hand type, optionally using wilds. Functions are written:
# Determine if a hand is a flush
isFlush <- function(suits, useWild=4) {
apply(suits, 1, FUN=function(x) ifelse(min(x)==max(x), TRUE, (max(x[x!=useWild])==min(x[x!=useWild]))))
}
# Determine if a hand is a straight (hard-coded for 5-card hands in a 13-card deck, Ace high or low)
isStraight <- function(rankCounts, isEligible=TRUE) {
# Exclusion matrix for straights, currently designed only for 13-card decks and A high or low
strMatrix <- matrix(data=0L, nrow=13, ncol=10)
strMatrix[c(1, 10, 11, 12, 13), 1] <- 1L
for (intCtr in 1:9) { strMatrix[intCtr:(intCtr+4), intCtr+1] <- 1L }
apply(rankCounts, 1, max)<=1 & rowSums(rankCounts%*%(strMatrix-1)==0)>=1 & isEligible
}
# Hard-coded for 52-card deck with 1 joker
findHandTypes <- function (aHands, retAll=FALSE) {
# Track hands that contain the joker and total number of wilds
aJoker <- rowSums(aHands==53)>0
nWild <- aJoker + rowSums(aHands%%13==2)
# 1. Calculate natural values
# 1a. Calculate ranks and suits, counting the joker as having no "rank" and being of a fifth "suit"
aRanks <- ifelse(aHands==53, 0, 1 + (aHands-1) %% 13)
aSuits <- ifelse(aHands==53, 0, 1 + (aHands-1) %/% 13)
# 1b. Find the counts by rank in each hand
aRankCount <- matrix(data=-1L, nrow=nrow(aHands), ncol=13)
for (intCtr in 1:13) { aRankCount[, intCtr] <- rowSums(aRanks == intCtr) }
# 1c. Find the natural flushes and straights
nFlush <- isFlush(aSuits, useWild=-1)
nStraight <- isStraight(aRankCount, isEligible=!aJoker)
# 1d. Find max and count of ranks
nQuads <- rowSums(aRankCount == 4)
nTrips <- rowSums(aRankCount == 3)
nPairs <- rowSums(aRankCount == 2)
# 1e. Score the natural hand values (default is that a hand has nothing of value)
nType <- rep(0L, nrow(aHands))
# Five wilds (cannot exist) <- 1
nType[nFlush==1 & nStraight==1 & aRankCount[, 1]==1 & aRankCount[, 13]==1] <- 2 # Royal
# Five of a kind (cannot exist as natural) <- 3
nType[nFlush==1 & nStraight==1 & (aRankCount[, 1]!=1 | aRankCount[, 13]!=1)] <- 4 # Straight flush
nType[nQuads==1] <- 5 # Four of a kind
nType[nTrips==1 & nPairs==1] <- 6 # Full House
nType[nFlush==1 & nStraight==0] <- 7 # Flush
nType[nFlush==0 & nStraight==1] <- 8 # Straight
nType[nTrips==1 & nPairs==0] <- 9 # Three of a Kind
nType[nPairs==2] <- 10 # Two Pair
nType[nTrips==0 & nPairs==1] <- 11 # Pair
# 2. Calculate wild values
# 2a. Calculate ranks and suits, counting the joker and 2's as having no "rank" and being of a fifth "suit"
wRanks <- ifelse(aHands==53|(aHands%%13==2), 0, 1 + (aHands-1) %% 13)
wSuits <- ifelse(aHands==53|(aHands%%13==2), 0, 1 + (aHands-1) %/% 13)
# 2b. Find the counts by rank in each hand
wRankCount <- matrix(data=-1L, nrow=nrow(aHands), ncol=13)
for (intCtr in 1:13) { wRankCount[, intCtr] <- rowSums(wRanks == intCtr) }
# 2c. Find the wild flushes and straights
wFlush <- isFlush(wSuits, useWild=0)
wStraight <- isStraight(wRankCount, isEligible=TRUE)
# 2d. Find max and count of ranks
wQuads <- rowSums(wRankCount == 4)
wTrips <- rowSums(wRankCount == 3)
wPairs <- rowSums(wRankCount == 2)
# 2e. Score the wild hand values (default is that a hand has nothing of value)
wType <- rep(0L, nrow(aHands))
# 2e1. Calculate number of royal cards in hand
nRoyal <- rowSums(wRankCount[, c(1, 10, 11, 12, 13)])
# 2e2. Five wilds (always five wilds)
wType[nWild==5] <- 1 # Five wild
# 2e3. Four wilds (always either royal flush or five of a kind)
wType[nWild==4 & nRoyal==1] <- 2 # Royal
wType[nWild==4 & nRoyal==0] <- 3 # Five of a kind
# 2e4. Three wilds (always either royal flush or five of a kind or straight flush or four of a kind)
wType[nWild==3 & wFlush==1 & wStraight==1 & nRoyal==2] <- 2 # Royal
wType[nWild==3 & wPairs==1] <- 3 # Five of a kind
wType[nWild==3 & wFlush==1 & wStraight==1 & nRoyal<2] <- 4 # Straight Flush
wType[nWild==3 & !(wFlush==1 & wStraight==1) & wPairs==0] <- 5 # Four of a kind
# 2e5. Two wilds (always either royal, five of a kind, straight flush, four of a kind, flush, straight, trips)
# Cannot be a full house as any 3-2 using two wilds could instead be 5-0 or 1-4 and thus a better hand
wType[nWild==2 & wFlush==1 & wStraight==1 & nRoyal==3] <- 2 # Royal
wType[nWild==2 & wTrips==1] <- 3 # Five of a kind
wType[nWild==2 & wFlush==1 & wStraight==1 & nRoyal<3] <- 4 # Straight Flush
wType[nWild==2 & wPairs==1] <- 5 # Four of a kind
wType[nWild==2 & wFlush==1 & wStraight==0] <- 7 # Flush
wType[nWild==2 & wFlush==0 & wStraight==1] <- 8 # Straight
wType[nWild==2 & !(wFlush==1 | wStraight==1) & wPairs==0 & wTrips==0] <- 9 # Three of a kind
# 2e6. One wild (can be anything from pair to royal, with the exception of never two pair)
wType[nWild==1 & wFlush==1 & wStraight==1 & nRoyal==4] <- 2 # Royal
wType[nWild==1 & wQuads==1] <- 3 # Five of a kind
wType[nWild==1 & wFlush==1 & wStraight==1 & nRoyal<4] <- 4 # Straight Flush
wType[nWild==1 & wTrips==1] <- 5 # Four of a kind
wType[nWild==1 & wPairs==2] <- 6 # Full House
wType[nWild==1 & wFlush==1 & wStraight==0] <- 7 # Flush
wType[nWild==1 & wFlush==0 & wStraight==1] <- 8 # Straight
wType[nWild==1 & wPairs==1] <- 9 # Three of a kind
wType[nWild==1 & !(wFlush==1 | wStraight==1) & wPairs==0 & wTrips==0 & wQuads==0] <- 11 # Pair
# 2e7. No wild (is identical to natural)
wType[nWild==0] <- nType[nWild==0]
# Return the requested data
if (isTRUE(retAll)) {
list(nType=nType,
wType=wType,
nWild=nWild,
wRankCount=wRankCount,
aRankCount=aRankCount
)
} else {
list(nType=nType, wType=wType, nWild=nWild)
}
}# Calculate hands
tmpTime <- proc.time(); tmpHandTypes<-findHandTypes(mtxHands, retAll=TRUE); proc.time()-tmpTime## user system elapsed
## 66.01 4.00 70.33Hand types are evaluated:
# Create tibble
tblAllTypes <- tibble::tibble(wType=tmpHandTypes$wType,
nType=tmpHandTypes$nType,
nWild=tmpHandTypes$nWild
) %>%
mutate(wType=ifelse(wType==0, 99, wType),
nType=ifelse(nType==0, 99, nType)
)
tblAllTypes## # A tibble: 2,869,685 × 3
## wType nType nWild
## <dbl> <dbl> <dbl>
## 1 4 4 1
## 2 7 7 1
## 3 7 7 1
## 4 7 7 1
## 5 7 7 1
## 6 7 7 1
## 7 7 7 1
## 8 7 7 1
## 9 7 7 1
## 10 9 11 1
## # … with 2,869,675 more rows# Plot the overlaps
tblAllTypes %>%
count(wType, nType) %>%
mutate(wType=ifelse(wType %in% c(1, 3), case_when(wType==3 ~ "3 (5K)", wType==1 ~ "1 (5W)"), wType),
nType=case_when(nType==2 ~ "2 (RF)", nType==4 ~ "4 (SF)", nType==5 ~ "5 (4K)", nType==6 ~ "6 (FH)",
nType==7 ~ "7 (FL)", nType==8 ~ "8 (ST)", nType==9 ~ "9 (3K)", nType==10 ~ "10 (2P)",
nType==11 ~ "11 (Pair)", nType==99 ~ "99 (HC)", TRUE ~ "Error"
)
) %>%
mutate(wType=factor(wType,
levels=c("99", "11", "10", "9", "8", "7", "6", "5", "4", "3 (5K)", "2", "1 (5W)")
),
nType=factor(nType,
levels=c("99 (HC)", "11 (Pair)", "10 (2P)", "9 (3K)", "8 (ST)", "7 (FL)",
"6 (FH)", "5 (4K)", "4 (SF)", "2 (RF)"
)
)
) %>%
ggplot(aes(x=wType, y=nType)) +
geom_tile(aes(fill=(n>0))) +
geom_text(aes(label=n), size=3) +
scale_fill_discrete("Overlap\nexists?") +
labs(title="Number of hands by type in 53c5 game",
subtitle="Deuces can be natural or wild, joker (card 53) is wild only",
y="Natural hand type",
x="Wild hand type"
)
Hands can be scored based on a paytable for both wild-type hands and natural-type hands (only the highest payout applies). An example from the game “DJ Wild” is assessed:
# Hand values
handValues <- tibble::tibble(handRank=c(1:11, 99),
handDesc=c("5W", "RF", "5K", "SF", "4K", "FH", "FL", "ST", "3K", "2P", "1P", "HC"),
handLabel=paste0(handRank, " (", handDesc, ")"),
blindPay=c(2000, 100, 40, 25, 5, 4, 3, 2, 0, 0, 0, 0),
wildPay=c(2000, 90, 70, 25, 6, 5, 4, 3, 1, -1, -1, -1),
naturalPay=c(NA, 1000, NA, 200, 60, 30, 25, 20, 6, -1, -1, -1)
)
handValues## # A tibble: 12 × 6
## handRank handDesc handLabel blindPay wildPay naturalPay
## <dbl> <chr> <chr> <dbl> <dbl> <dbl>
## 1 1 5W 1 (5W) 2000 2000 NA
## 2 2 RF 2 (RF) 100 90 1000
## 3 3 5K 3 (5K) 40 70 NA
## 4 4 SF 4 (SF) 25 25 200
## 5 5 4K 5 (4K) 5 6 60
## 6 6 FH 6 (FH) 4 5 30
## 7 7 FL 7 (FL) 3 4 25
## 8 8 ST 8 (ST) 2 3 20
## 9 9 3K 9 (3K) 0 1 6
## 10 10 2P 10 (2P) 0 -1 -1
## 11 11 1P 11 (1P) 0 -1 -1
## 12 99 HC 99 (HC) 0 -1 -1# Create a mapping vector for type to description
vecMapHands <- handValues$handLabel %>% purrr::set_names(handValues$handRank)
# Payout grid plotted for all possible values
allValueGrid <- expand.grid(wildType=c(1:11, 99), naturalType=c(1:11, 99)) %>%
tibble::tibble() %>%
full_join(count(tblAllTypes, wType, nType), by=c("wildType"="wType", "naturalType"="nType")) %>%
mutate(bestType=pmin(wildType, naturalType)) %>%
left_join(select(handValues, handRank, wildPay), by=c("wildType"="handRank")) %>%
left_join(select(handValues, handRank, naturalPay), by=c("naturalType"="handRank")) %>%
left_join(select(handValues, handRank, blindPay), by=c("bestType"="handRank")) %>%
mutate(bonusPay=pmax(wildPay, naturalPay, na.rm=TRUE))
allValueGrid## # A tibble: 144 × 8
## wildType naturalType n bestType wildPay naturalPay blindPay bonusPay
## <dbl> <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 1 NA 1 2000 NA 2000 2000
## 2 2 1 NA 1 90 NA 2000 90
## 3 3 1 NA 1 70 NA 2000 70
## 4 4 1 NA 1 25 NA 2000 25
## 5 5 1 NA 1 6 NA 2000 6
## 6 6 1 NA 1 5 NA 2000 5
## 7 7 1 NA 1 4 NA 2000 4
## 8 8 1 NA 1 3 NA 2000 3
## 9 9 1 NA 1 1 NA 2000 1
## 10 10 1 NA 1 -1 NA 2000 -1
## # … with 134 more rows# Plot of payout values
allValueGrid %>%
filter(!is.na(n)) %>%
ggplot(aes(x=fct_rev(factor(vecMapHands[as.character(wildType)], levels=vecMapHands)),
y=fct_rev(factor(vecMapHands[as.character(naturalType)], levels=vecMapHands))
)
) +
geom_tile(fill="lightgreen") +
geom_text(aes(label=bonusPay)) +
labs(title="Example payouts by type in 53c5 game",
subtitle="Deuces can be natural or wild, joker (card 53) is wild only",
y="Natural hand type",
x="Wild hand type"
)
# EV of payout values
allValueGrid %>%
filter(!is.na(n)) %>%
summarize(totPays=sum(n*bonusPay), n=sum(n)) %>%
mutate(ev=totPays/n)## # A tibble: 1 × 3
## totPays n ev
## <dbl> <int> <dbl>
## 1 -176684 2869685 -0.0616# Table by hand type
allValueTable <- allValueGrid %>%
filter(!is.na(n)) %>%
mutate(natWild=ifelse(naturalPay>wildPay, "Natural", "Wild"),
reportBonusType=ifelse(natWild=="Natural", naturalType, wildType),
reportBonusLabel=factor(vecMapHands[as.character(reportBonusType)], levels=vecMapHands)
) %>%
group_by(natWild, reportBonusLabel, bonusPay) %>%
summarize(n=sum(n), .groups="drop") %>%
mutate(prob=n/sum(n), per=1/prob, ev=n*bonusPay/sum(n))
allValueTable## # A tibble: 19 × 7
## natWild reportBonusLabel bonusPay n prob per ev
## <chr> <fct> <dbl> <int> <dbl> <dbl> <dbl>
## 1 Natural 2 (RF) 1000 4 0.00000139 717421. 0.00139
## 2 Natural 4 (SF) 200 36 0.0000125 79713. 0.00251
## 3 Natural 5 (4K) 60 528 0.000184 5435. 0.0110
## 4 Natural 6 (FH) 30 3168 0.00110 906. 0.0331
## 5 Natural 7 (FL) 25 4980 0.00174 576. 0.0434
## 6 Natural 8 (ST) 20 10176 0.00355 282. 0.0709
## 7 Natural 9 (3K) 6 42240 0.0147 67.9 0.0883
## 8 Wild 1 (5W) 2000 1 0.000000348 2869685 0.000697
## 9 Wild 2 (RF) 90 1000 0.000348 2870. 0.0314
## 10 Wild 3 (5K) 70 1400 0.000488 2050. 0.0342
## 11 Wild 4 (SF) 25 3612 0.00126 794. 0.0315
## 12 Wild 5 (4K) 6 51160 0.0178 56.1 0.107
## 13 Wild 6 (FH) 5 11880 0.00414 242. 0.0207
## 14 Wild 7 (FL) 4 13976 0.00487 205. 0.0195
## 15 Wild 8 (ST) 3 73824 0.0257 38.9 0.0772
## 16 Wild 9 (3K) 1 415800 0.145 6.90 0.145
## 17 Wild 10 (2P) -1 95040 0.0331 30.2 -0.0331
## 18 Wild 11 (1P) -1 1341180 0.467 2.14 -0.467
## 19 Wild 99 (HC) -1 799680 0.279 3.59 -0.279allValueTable %>% select(n, ev) %>% colSums() %>% round(4)## n ev
## 2869685.0000 -0.0616Convert all hands to a value with ranks for tie-breaking (Ace high, with 5432A straights treated as having first tie-breaker 5 and last tie-breaker A). Hands are first converted to counts by rank with wild cards filling the next best ranks:
# Get the number of wilds in each hand
perHandNWild <- (rowSums(mtxHands==53)>0) + rowSums(mtxHands%%13==2)
# Get the ranks in each hand
perHandRanks <- ifelse(mtxHands==53, 0, 1 + (mtxHands-1) %% 13) # track joker as wild
perHandRanks[perHandRanks==2] <- 0 # track deuces as wild, ignore rank (place as best later)
perHandRanks[perHandRanks==1] <- 14 # count Aces as high
# Create the matrix of card types
perHandRankCount <- matrix(data=-1L, nrow=nrow(mtxHands), ncol=14)
for (intCtr in 1:14) { perHandRankCount[, intCtr] <- rowSums(perHandRanks == intCtr) }
# Create a tie-breaker matrix filled with 0's (column 13 is Ace)
mtxTieBreak <- matrix(data=0L, nrow=nrow(mtxHands), ncol=13)
# Function to get the cards in a straight
getStraightType <- function(x) {
if(min(x[x>0]) >= 10) c(10, 11, 12, 13, 14)
else if(min(x[x>0]) <= 5 & max(x)==14) c(2, 3, 4, 5, 14) # this treats Ace as the last card to resolve (Ace low)
else seq(min(x[x>0]), min(x[x>0])+4)
}
# Function to get the cards in a flush
getFlushType <- function(x) {
# Wild cards should be added as highest rank not already in hand (try A then K then Q then J then T)
numAdd <- sum(x==0)
if(numAdd > 0) {
notThere <- (14:10)[!((14:10) %in% x)][1:numAdd]
x <- c(x[x!=0], notThere)
}
sort(x, decreasing=TRUE)
}
# Function to get the cards in a four of a kind, full house, three of a kind, two pair, pair, or high card
getHighTypes <- function(rks, idx=1:14, outNum=c(1, 1, 1, 1, 1)) {
vecOut <- rep(0L, length(outNum))
for(x in seq_along(outNum)) {
vecOut[x]<-max((rks==max(rks)) * idx)
rks[match(vecOut[x], idx)] <- 0
}
rep(vecOut, times=outNum)
}
# 1. Five wild (nothing to do)
# 2. Royal flush (make the ranks 1 in the last 5 columns)
perHandRanks[tmpHandTypes$wType==2, ] <- t(apply(perHandRanks[tmpHandTypes$wType==2, ], 1, FUN=getStraightType))
# 3. Five of a kind (make the ranks all the same as the only rank)
perHandRanks[tmpHandTypes$wType==3, ] <- t(apply(perHandRankCount[tmpHandTypes$wType==3, ],
1,
FUN=getHighTypes,
outNum=c(5)
)
)
# 4. Straight flush (make the ranks all the best straight possible)
perHandRanks[tmpHandTypes$wType==4, ] <- t(apply(perHandRanks[tmpHandTypes$wType==4, ], 1, FUN=getStraightType))
# 5. Four of a kind (make the ranks four of the most frequent card or the highest card, one of the other)
perHandRanks[tmpHandTypes$wType==5, ] <- t(apply(perHandRankCount[tmpHandTypes$wType==5, ],
1,
FUN=getHighTypes,
outNum=c(4, 1)
)
)
# 6. Full house (make the ranks three of the most frequent card, two of the other)
perHandRanks[tmpHandTypes$wType==6, ] <- t(apply(perHandRankCount[tmpHandTypes$wType==6, ],
1,
FUN=getHighTypes,
outNum=c(3, 2)
)
)
# 7. Flush (need to implement)
perHandRanks[tmpHandTypes$wType==7, ] <- t(apply(perHandRanks[tmpHandTypes$wType==7, ], 1, FUN=getFlushType))
# 8. Straight (make the ranks all the best straight possible)
perHandRanks[tmpHandTypes$wType==8, ] <- t(apply(perHandRanks[tmpHandTypes$wType==8, ], 1, FUN=getStraightType))
# 9. Three of a kind (make the ranks three of the most frequent or highest card, one each of the other)
perHandRanks[tmpHandTypes$wType==9, ] <- t(apply(perHandRankCount[tmpHandTypes$wType==9, ],
1,
FUN=getHighTypes,
outNum=c(3, 1, 1)
)
)
# 10. Two pair (make the ranks two of the highest pair, two of the lowest pair, one of the remainder)
perHandRanks[tmpHandTypes$wType==10, ] <- t(apply(perHandRankCount[tmpHandTypes$wType==10, ],
1,
FUN=getHighTypes,
outNum=c(2, 2, 1)
)
)
# 11. One pair (make the ranks two of the pair or highest card, one each of the remainder)
perHandRanks[tmpHandTypes$wType==11, ] <- t(apply(perHandRankCount[tmpHandTypes$wType==11, ],
1,
FUN=getHighTypes,
outNum=c(2, 1, 1, 1)
)
)
# 0. High card (make the ranks in order of the highest cards)
perHandRanks[tmpHandTypes$wType==0, ] <- t(apply(perHandRankCount[tmpHandTypes$wType==0, ],
1,
FUN=getHighTypes,
outNum=c(1, 1, 1, 1, 1)
)
)
# Create the hand ranking table
allHandRanks <- tibble::tibble(handNum=1:nrow(mtxHands), wType=tmpHandTypes$wType) %>%
bind_cols(perHandRanks) %>%
set_names(c("handNum", "wType", "tb1", "tb2", "tb3", "tb4", "tb5")) %>%
mutate(wType=ifelse(wType==0, 99, wType)) %>%
arrange(wType, desc(tb1), desc(tb2), desc(tb3), desc(tb4), desc(tb5)) %>%
mutate(chgRank=ifelse(row_number()==1 | wType!=lag(wType) | tb1 != lag(tb1) | tb2 != lag(tb2) | tb3 != lag(tb3) | tb4 != lag(tb4) | tb5 != lag(tb5), 1, 0),
rank=cumsum(chgRank)
)## New names:
## • `` -> `...3`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`
## • `` -> `...7`allHandRanks %>%
count(wType, rank, tb1, tb2, tb3, tb4, tb5) %>%
arrange(-n, rank) %>%
mutate(nvr=row_number()) %>%
group_by(wType) %>%
mutate(nty=row_number()) %>%
ungroup() %>%
filter(nvr<=10 | nty==1)## # A tibble: 20 × 10
## wType rank tb1 tb2 tb3 tb4 tb5 n nvr nty
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <int> <int>
## 1 8 1071 10 11 12 13 14 13320 1 1
## 2 8 1072 9 10 11 12 13 9660 2 2
## 3 8 1073 8 9 10 11 12 9660 3 3
## 4 8 1074 7 8 9 10 11 9660 4 4
## 5 8 1075 6 7 8 9 10 9660 5 5
## 6 8 1076 5 6 7 8 9 9660 6 6
## 7 8 1077 4 5 6 7 8 9660 7 7
## 8 8 1078 3 4 5 6 7 9660 8 8
## 9 8 1079 2 3 4 5 14 3060 9 9
## 10 11 2402 14 14 13 12 9 1644 10 1
## 11 9 1083 14 14 14 13 9 1144 471 1
## 12 99 4380 14 13 12 11 9 1020 636 1
## 13 2 2 10 11 12 13 14 1004 1420 1
## 14 4 15 9 10 11 12 13 484 1916 1
## 15 5 27 14 14 14 14 9 484 1923 1
## 16 7 289 14 13 12 11 7 324 3574 1
## 17 6 155 14 14 14 13 13 204 3581 1
## 18 10 1740 14 14 13 13 12 144 3675 1
## 19 3 8 9 9 9 9 9 125 4335 1
## 20 1 1 0 0 0 0 0 1 5163 1As expected, straight is the hand type with the greatest number of possible ties (there are only 10 types of straight and each can have 1,024 permutations of suits)
A function is written to assess probabilities associated with any given hand:
# Sort allHandRanks and ensure handNum and row_number() match
sortedHandRanks <- allHandRanks %>%
mutate(qual=ifelse(wType<=11, "Q", "N")) %>%
arrange(handNum)
if (sum((sortedHandRanks$handNum) != (1:nrow(sortedHandRanks)))>0)
stop("\nError in handNum order in sortedHandRanks\n")
# Function to get probabilities
findHandProbs <- function(exRank, idxExclude=NULL, df=sortedHandRanks) {
rkData <- if(is.null(idxExclude)) df$rank else df$rank[-idxExclude]
qualData <- if(is.null(idxExclude)) df$qual else df$qual[-idxExclude]
pLN <- mean(rkData < exRank & qualData=="N")
pLQ <- mean(rkData < exRank & qualData=="Q")
pTN <- mean(rkData == exRank & qualData=="N")
pTQ <- mean(rkData == exRank & qualData=="Q")
pWN <- mean(rkData > exRank & qualData=="N")
pWQ <- mean(rkData > exRank & qualData=="Q")
pWNoTie <- (pWN+pWQ)/(1-pTN-pTQ)
c(pLN=pLN, pLQ=pLQ, pTN=pTN, pTQ=pTQ, pWN=pWN, pWQ=pWQ, pWNoTie=pWNoTie)
}
# Example hand index
exHandNum <- 123456
exHandRank <- sortedHandRanks$rank[exHandNum]
cat("\nExample hand",
exHandNum,
"is of type",
sortedHandRanks$wType[exHandNum],
"and rank",
exHandRank,
"with cards",
mtxHands[exHandNum,],
"\n"
)##
## Example hand 123456 is of type 99 and rank 4509 with cards 1 9 11 44 51res <- findHandProbs(exHandRank)
cat("Associated probabilities (if cards in example hand available to replay):",
"\nLoss: ", res["pLN"]+res["pLQ"],
"\nTie: ", res["pTN"]+res["pTQ"],
"\nWin (no qualify): ", res["pWN"],
"\nWin (qualify): ", res["pWQ"],
"\nWin (excluding ties):", res["pWNoTie"],
"\np(dealer qualifies):", res["pLQ"]+res["pTQ"]+res["pWQ"],
"\nOptimal action: ", ifelse(res["pWNoTie"]<0.25, "Fold", ifelse(res["pWNoTie"]<=0.5, "Single", "Double")),
"\n"
)## Associated probabilities (if cards in example hand available to replay):
## Loss: 0.767187
## Tie: 0.0003554397
## Win (no qualify): 0.2324576
## Win (qualify): 0
## Win (excluding ties): 0.2325402
## p(dealer qualifies): 0.7213353
## Optimal action: FoldThe function is run excluding unavailable cards (e.g., none of a player’s cards can appear in the dealer’s hand). First, a list of exclusions is generated:
# Get all exclusion indices once
cardInHand <- lapply(1:53, FUN=function(x) which(rowSums(mtxHands==x)>0))Then, the function is written and applied to the example hand:
# Function to get key values
getKeyValues <- function(keyRank, exclCards=c(), lstExclude=cardInHand, dfSort=sortedHandRanks) {
# Get the union of exclusions
if(length(exclCards)==0) exclHands<-c()
else exclHands <- purrr::reduce(.x=lstExclude[c(exclCards)], .f=union)
dfSort %>%
filter(!(handNum %in% exclHands)) %>%
summarize(pLQ=mean(qual=="Q" & rank<keyRank),
pLN=mean(qual=="N" & rank<keyRank),
pTQ=mean(qual=="Q" & rank==keyRank),
pTN=mean(qual=="N" & rank==keyRank),
pWQ=mean(qual=="Q" & rank>keyRank),
pWN=mean(qual=="N" & rank>keyRank),
n=n()
) %>%
mutate(pWNoTie=(pWQ+pWN)/(1-pTQ-pTN), rank=keyRank)
}
smallSorted <- sortedHandRanks %>% select(handNum, rank, qual)
# Heads up probabilities
t <- proc.time(); getKeyValues(exHandRank, exclCards=mtxHands[exHandNum,], dfSort=smallSorted); proc.time() - t## # A tibble: 1 × 9
## pLQ pLN pTQ pTN pWQ pWN n pWNoTie rank
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 0.735 0.0408 0 0.000141 0 0.224 1712304 0.224 4509## user system elapsed
## 1.48 0.25 2.05# Heads up probabilities, dealer does not have a wild card
t <- proc.time()
getKeyValues(exHandRank, exclCards=unique(c(mtxHands[exHandNum,], 2, 15, 28, 41, 53)), dfSort=smallSorted)## # A tibble: 1 × 9
## pLQ pLN pTQ pTN pWQ pWN n pWNoTie rank
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 0.529 0.0725 0 0.000250 0 0.398 962598 0.398 4509proc.time() - t## user system elapsed
## 1.36 0.29 1.80As expected, probabilities change slightly due to cards made unavailable (in player’s hands or otherwise). Wild cards are very important in expected value of hand quality
A function is added to run multiple hands:
# Blind payouts
blindPay <- c(2000, 100, 40, 25, 5, 4, 3, 2, 0, 0, 0, 0) %>% purrr::set_names(paste0("b_", c(1:11, 99)))
# Add number of wilds
sortedHandRanks <- sortedHandRanks %>%
mutate(nWild=perHandNWild)
calculateResults <- function(useHandNums, dfRanks=sortedHandRanks, hands=mtxHands, bPay=blindPay) {
map_dfr(useHandNums,
.f=function(x) {
getKeyValues(keyRank=dfRanks$rank[x], exclCards=as.vector(hands[x,])) %>%
mutate(type=dfRanks$wType[x],
handNum=x,
betPlay=ifelse((4*pWQ+3*pWN+2*pTQ+2*pTN)<(pLQ+pLN), 0, ifelse(pWNoTie<0.5, 1, 2)),
evAnte=ifelse(betPlay==0, -1, pWQ-pLQ-pLN),
evPlay=betPlay*(pWQ+pWN-pLQ-pLN),
evBlind=ifelse(betPlay==0, -1, bPay[paste0("b_", type)]*(pWQ+pWN)-pLQ-pLN),
evAll=evAnte+evPlay+evBlind
)
}
)
}# Run for example hand of all hand types 4 (straight flush) or better
seq1a <- sortedHandRanks %>%
filter(wType <= 4) %>%
group_by(nWild, wType, tb1, tb2, tb3, tb4, tb5) %>%
filter(row_number()==1) %>%
ungroup()
# Run for select hands
t <- proc.time(); resSFPlus <- calculateResults(useHandNums=seq1a$handNum); proc.time()-t## user system elapsed
## 46.34 11.69 64.90# Statistics for EV by hand type
resSFPlus %>%
group_by(type) %>%
summarize(n=n(), across(c(pWNoTie, evAll), .fns=list(min=min, mean=mean, med=median, max=max)))## # A tibble: 4 × 10
## type n pWNoTie_…¹ pWNoT…² pWNoT…³ pWNoT…⁴ evAll…⁵ evAll…⁶ evAll…⁷ evAll…⁸
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 1 1 1 1 1 2003. 2003. 2003. 2003.
## 2 2 5 1.00 1.00 1 1 103. 103. 103. 103.
## 3 3 43 0.999 1.00 1.00 1.00 42.6 42.7 42.7 42.7
## 4 4 31 0.997 0.999 0.999 1.00 27.6 27.7 27.7 27.7
## # … with abbreviated variable names ¹pWNoTie_min, ²pWNoTie_mean, ³pWNoTie_med,
## # ⁴pWNoTie_max, ⁵evAll_min, ⁶evAll_mean, ⁷evAll_med, ⁸evAll_max# Plot for result type
resSFPlus %>%
mutate(qualifies=pWQ+pTQ+pLQ, ties=pTQ+pTN) %>%
select(handNum, type, pWQ, pWN, pLQ, pLN, ties, qualifies) %>%
pivot_longer(-c(handNum, type)) %>%
ggplot(aes(x=factor(type), y=value)) +
geom_boxplot(fill="lightblue") +
facet_wrap(~name) +
labs(title="Probabilities of results by hand type", x="Hand type", y="Probability")
# Run for example hand of all hand types 5-8 (4K thru straight) or better
seq1b <- sortedHandRanks %>%
filter(wType <= 8 & wType >= 5) %>%
group_by(nWild, wType, tb1, tb2, tb3, tb4, tb5) %>%
filter(row_number()==1) %>%
ungroup()
# Run for select hands
t <- proc.time(); resSTto4K <- calculateResults(useHandNums=seq1b$handNum); proc.time()-t## user system elapsed
## 934.98 243.20 1263.75# Statistics for EV by hand type
resSTto4K %>%
group_by(type) %>%
summarize(n=n(), across(c(pWNoTie, evAll), .fns=list(min=min, mean=mean, med=median, max=max)))## # A tibble: 4 × 10
## type n pWNoTie_…¹ pWNoT…² pWNoT…³ pWNoT…⁴ evAll…⁵ evAll…⁶ evAll…⁷ evAll…⁸
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 5 462 0.974 0.991 0.993 1.00 7.44 7.60 7.60 7.73
## 2 6 198 0.968 0.974 0.972 0.984 6.40 6.45 6.44 6.53
## 3 7 1173 0.962 0.968 0.964 0.987 5.36 5.41 5.38 5.53
## 4 8 26 0.931 0.960 0.961 0.982 4.10 4.33 4.34 4.49
## # … with abbreviated variable names ¹pWNoTie_min, ²pWNoTie_mean, ³pWNoTie_med,
## # ⁴pWNoTie_max, ⁵evAll_min, ⁶evAll_mean, ⁷evAll_med, ⁸evAll_max# Plot for result type
resSTto4K %>%
mutate(qualifies=pWQ+pTQ+pLQ, ties=pTQ+pTN) %>%
select(handNum, type, pWQ, pWN, pLQ, pLN, ties, qualifies) %>%
pivot_longer(-c(handNum, type)) %>%
ggplot(aes(x=factor(type), y=value)) +
geom_boxplot(fill="lightblue") +
facet_wrap(~name) +
labs(title="Probabilities of results by hand type", x="Hand type", y="Probability")
# Run for example hand of all hand types 9-10 (3K thru 2P)
seq1c <- sortedHandRanks %>%
filter(wType <= 10 & wType >= 9) %>%
group_by(nWild, wType, tb1, tb2, tb3, tb4, tb5) %>%
filter(row_number()==1) %>%
ungroup()
# Run for select hands
t <- proc.time(); res3Kto2P <- calculateResults(useHandNums=seq1c$handNum); proc.time()-t## user system elapsed
## 1189.44 308.09 1610.83# Statistics for EV by hand type
res3Kto2P %>%
group_by(type) %>%
summarize(n=n(), across(c(pWNoTie, evAll), .fns=list(min=min, mean=mean, med=median, max=max)))## # A tibble: 2 × 10
## type n pWNoTie_…¹ pWNoT…² pWNoT…³ pWNoT…⁴ evAll…⁵ evAll…⁶ evAll…⁷ evAll…⁸
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 9 1485 0.746 0.857 0.857 0.961 0.972 1.72 1.71 2.39
## 2 10 660 0.717 0.739 0.740 0.755 0.761 0.913 0.919 1.03
## # … with abbreviated variable names ¹pWNoTie_min, ²pWNoTie_mean, ³pWNoTie_med,
## # ⁴pWNoTie_max, ⁵evAll_min, ⁶evAll_mean, ⁷evAll_med, ⁸evAll_max# Plot for result type
res3Kto2P %>%
mutate(qualifies=pWQ+pTQ+pLQ, ties=pTQ+pTN) %>%
select(handNum, type, pWQ, pWN, pLQ, pLN, ties, qualifies) %>%
pivot_longer(-c(handNum, type)) %>%
ggplot(aes(x=factor(type), y=value)) +
geom_boxplot(fill="lightblue") +
facet_wrap(~name) +
labs(title="Probabilities of results by hand type", x="Hand type", y="Probability")
# Run for example hand of all hand types 11 with no wild (pair)
seq1d <- sortedHandRanks %>%
filter(wType == 11 & nWild==0) %>%
group_by(nWild, wType, tb1, tb2, tb3, tb4, tb5) %>%
filter(row_number()==1) %>%
ungroup()
# Run for select hands
t <- proc.time(); resPairNoWild <- calculateResults(useHandNums=seq1d$handNum); proc.time()-t## user system elapsed
## 1048.64 280.61 1421.57resPairNoWild## # A tibble: 1,980 × 16
## pLQ pLN pTQ pTN pWQ pWN n pWNoTie rank type handNum
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl> <int>
## 1 0.331 0 0.0000158 0 0.409 0.260 1712304 0.669 2564 11 20834
## 2 0.736 0 0.0000158 0 0.00383 0.260 1712304 0.264 4259 11 20836
## 3 0.722 0 0.0000158 0 0.0176 0.260 1712304 0.278 4094 11 20837
## 4 0.708 0 0.0000158 0 0.0314 0.260 1712304 0.292 3929 11 20838
## 5 0.330 0 0.000168 0 0.409 0.260 1712304 0.670 2563 11 20881
## 6 0.736 0 0.0000158 0 0.00385 0.260 1712304 0.264 4258 11 20883
## 7 0.722 0 0.0000158 0 0.0176 0.260 1712304 0.278 4093 11 20884
## 8 0.683 0 0.0000158 0 0.0569 0.261 1712304 0.317 3764 11 20886
## 9 0.329 0 0.000168 0 0.411 0.260 1712304 0.671 2560 11 20927
## 10 0.736 0 0.0000158 0 0.00390 0.260 1712304 0.264 4256 11 20929
## # … with 1,970 more rows, and 5 more variables: betPlay <dbl>, evAnte <dbl>,
## # evPlay <dbl>, evBlind <dbl>, evAll <dbl># Statistics for EV by hand type
resPairNoWild %>%
full_join(select(seq1d, handNum, tb1), by="handNum") %>%
group_by(tb1) %>%
summarize(n=n(), across(c(pWNoTie, evAll), .fns=list(min=min, mean=mean, med=median, max=max)))## # A tibble: 12 × 10
## tb1 n pWNoTie…¹ pWNoT…² pWNoT…³ pWNoT…⁴ evAll…⁵ evAll…⁶ evAll…⁷ evAll…⁸
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 3 165 0.260 0.263 0.263 0.265 -1.96 -1.94 -1.95 -1.93
## 2 4 165 0.274 0.286 0.288 0.291 -1.89 -1.83 -1.82 -1.81
## 3 5 165 0.288 0.308 0.313 0.317 -1.82 -1.72 -1.70 -1.68
## 4 6 165 0.302 0.331 0.329 0.343 -1.75 -1.61 -1.62 -1.55
## 5 7 165 0.328 0.353 0.354 0.368 -1.62 -1.50 -1.49 -1.42
## 6 8 165 0.353 0.377 0.381 0.396 -1.49 -1.38 -1.36 -1.28
## 7 9 165 0.382 0.406 0.402 0.429 -1.35 -1.23 -1.25 -1.11
## 8 10 165 0.414 0.440 0.440 0.472 -1.19 -1.06 -1.06 -0.901
## 9 11 165 0.455 0.484 0.490 0.528 -0.987 -0.837 -0.813 -0.567
## 10 12 165 0.508 0.540 0.534 0.580 -0.708 -0.481 -0.525 -0.199
## 11 13 165 0.577 0.610 0.605 0.645 -0.221 0.0118 -0.0275 0.253
## 12 14 165 0.669 0.698 0.698 0.723 0.421 0.624 0.624 0.797
## # … with abbreviated variable names ¹pWNoTie_min, ²pWNoTie_mean, ³pWNoTie_med,
## # ⁴pWNoTie_max, ⁵evAll_min, ⁶evAll_mean, ⁷evAll_med, ⁸evAll_max# Plot for result type
resPairNoWild %>%
full_join(select(seq1d, handNum, tb1), by="handNum") %>%
mutate(qualifies=pWQ+pTQ+pLQ, ties=pTQ+pTN) %>%
select(handNum, tb1, pWQ, pWN, pLQ, pLN, ties, qualifies) %>%
pivot_longer(-c(handNum, tb1)) %>%
ggplot(aes(x=factor(tb1), y=value)) +
geom_boxplot(fill="lightblue") +
facet_wrap(~name) +
labs(title="Probabilities of results by pair type (no wild)", x="Pair type", y="Probability")
# Run for example hand of all hand types 11 with wild (pair) and type 99 (no pair)
seq1e <- sortedHandRanks %>%
filter(wType==99 | (wType == 11 & nWild==1)) %>%
group_by(nWild, wType, tb1, tb2, tb3, tb4, tb5) %>%
filter(row_number()==1) %>%
ungroup()
# Run for select hands
t <- proc.time(); resWildPairNoPair <- calculateResults(useHandNums=seq1e$handNum); proc.time()-t## user system elapsed
## 698.46 189.06 984.62resWildPairNoPair## # A tibble: 1,245 × 16
## pLQ pLN pTQ pTN pWQ pWN n pWNoTie rank type handNum
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl> <int>
## 1 0.306 0 0.000232 0 0.397 0.297 1712304 0.694 2563 11 15
## 2 0.304 0 0.000232 0 0.399 0.297 1712304 0.696 2560 11 16
## 3 0.301 0 0.000232 0 0.402 0.297 1712304 0.699 2554 11 17
## 4 0.297 0 0.000232 0 0.406 0.297 1712304 0.703 2544 11 18
## 5 0.290 0 0.000232 0 0.413 0.297 1712304 0.710 2529 11 19
## 6 0.281 0 0.000232 0 0.422 0.297 1712304 0.719 2508 11 20
## 7 0.268 0 0.000232 0 0.435 0.297 1712304 0.732 2480 11 21
## 8 0.251 0 0.000232 0 0.452 0.297 1712304 0.749 2444 11 22
## 9 0.305 0 0.000232 0 0.398 0.297 1712304 0.695 2562 11 63
## 10 0.303 0 0.000232 0 0.399 0.297 1712304 0.697 2559 11 64
## # … with 1,235 more rows, and 5 more variables: betPlay <dbl>, evAnte <dbl>,
## # evPlay <dbl>, evBlind <dbl>, evAll <dbl># Statistics for EV by hand type
resWildPairNoPair %>%
full_join(select(seq1e, handNum, tb1, nWild), by="handNum") %>%
group_by(type, nWild, tb1) %>%
summarize(n=n(), across(c(pWNoTie, evAll), .fns=list(min=min, mean=mean, med=median, max=max)))## `summarise()` has grouped output by 'type', 'nWild'. You can override using the
## `.groups` argument.## # A tibble: 14 × 12
## # Groups: type, nWild [2]
## type nWild tb1 n pWNoTie_min pWNoTi…¹ pWNoT…² pWNoT…³ evAll_…⁴ evAll…⁵
## <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 11 1 8 6 0.397 0.398 3.98e-1 4.00e-1 -1.31 -1.31
## 2 11 1 9 16 0.427 0.430 4.30e-1 4.33e-1 -1.16 -1.15
## 3 11 1 10 31 0.461 0.467 4.67e-1 4.73e-1 -0.994 -0.962
## 4 11 1 11 52 0.500 0.512 5.12e-1 5.23e-1 -0.795 -0.713
## 5 11 1 12 80 0.550 0.568 5.69e-1 5.86e-1 -0.449 -0.319
## 6 11 1 13 116 0.613 0.640 6.39e-1 6.65e-1 -0.00766 0.182
## 7 11 1 14 160 0.694 0.732 7.31e-1 7.67e-1 0.563 0.823
## 8 99 0 8 4 0 0.000282 2.82e-4 5.64e-4 -2 -2
## 9 99 0 9 14 0.000939 0.00231 2.29e-3 3.76e-3 -2 -2
## 10 99 0 10 34 0.00480 0.00872 8.81e-3 1.27e-2 -2 -2
## 11 99 0 11 69 0.0154 0.0242 2.37e-2 3.30e-2 -2 -2
## 12 99 0 12 125 0.0388 0.0561 5.54e-2 7.32e-2 -2 -2
## 13 99 0 13 209 0.0843 0.115 1.14e-1 1.45e-1 -2 -2
## 14 99 0 14 329 0.165 0.215 2.14e-1 2.64e-1 -2 -1.99
## # … with 2 more variables: evAll_med <dbl>, evAll_max <dbl>, and abbreviated
## # variable names ¹pWNoTie_mean, ²pWNoTie_med, ³pWNoTie_max, ⁴evAll_min,
## # ⁵evAll_mean# Plot for result type
resWildPairNoPair %>%
full_join(select(seq1e, handNum, tb1, nWild), by="handNum") %>%
mutate(qualifies=pWQ+pTQ+pLQ, ties=pTQ+pTN) %>%
select(handNum, tb1, nWild, type, pWQ, pWN, pLQ, pLN, ties, qualifies) %>%
pivot_longer(-c(handNum, tb1, nWild, type)) %>%
mutate(lab=paste0(type, "-", nWild, "-", stringr::str_pad(as.character(tb1), 2, side="left", pad="0"))) %>%
ggplot(aes(x=factor(lab), y=value)) +
geom_boxplot(fill="lightblue") +
facet_wrap(~name) +
labs(title="Probabilities of results by type\nPair with wild (11-1), or no pair (99-0)",
x="Type",
y="Probability"
)
The result files are combined and saved:
resAll_202301_v001 <- bind_rows(resWildPairNoPair,
resPairNoWild,
res3Kto2P,
resSTto4K,
resSFPlus,
.id="src"
) %>%
mutate(src=c("1"="Wild Pair or No Paor",
"2"="Pair, No Wild",
"3"="Two Pair or Trips",
"4"="Straight to Quads",
"5"="Straight Flush or Better"
)[src]
)
resAll_202301_v001## # A tibble: 7,309 × 17
## src pLQ pLN pTQ pTN pWQ pWN n pWNoTie rank type
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1 Wild Pair o… 0.306 0 2.32e-4 0 0.397 0.297 1.71e6 0.694 2563 11
## 2 Wild Pair o… 0.304 0 2.32e-4 0 0.399 0.297 1.71e6 0.696 2560 11
## 3 Wild Pair o… 0.301 0 2.32e-4 0 0.402 0.297 1.71e6 0.699 2554 11
## 4 Wild Pair o… 0.297 0 2.32e-4 0 0.406 0.297 1.71e6 0.703 2544 11
## 5 Wild Pair o… 0.290 0 2.32e-4 0 0.413 0.297 1.71e6 0.710 2529 11
## 6 Wild Pair o… 0.281 0 2.32e-4 0 0.422 0.297 1.71e6 0.719 2508 11
## 7 Wild Pair o… 0.268 0 2.32e-4 0 0.435 0.297 1.71e6 0.732 2480 11
## 8 Wild Pair o… 0.251 0 2.32e-4 0 0.452 0.297 1.71e6 0.749 2444 11
## 9 Wild Pair o… 0.305 0 2.32e-4 0 0.398 0.297 1.71e6 0.695 2562 11
## 10 Wild Pair o… 0.303 0 2.32e-4 0 0.399 0.297 1.71e6 0.697 2559 11
## # … with 7,299 more rows, and 6 more variables: handNum <int>, betPlay <dbl>,
## # evAnte <dbl>, evPlay <dbl>, evBlind <dbl>, evAll <dbl>saveToRDS(resAll_202301_v001, ovrWriteError=FALSE)##
## File already exists: ./RInputFiles/Coronavirus/resAll_202301_v001.RDS
##
## Not replacing the existing file since ovrWrite=FALSE## NULLResults are explored:
# Create the analysis frame
dfResAll_202301_v001 <- resAll_202301_v001 %>%
left_join(select(sortedHandRanks, handNum, nWild, wType, starts_with("tb")), by="handNum") %>%
full_join(sortedHandRanks %>% count(nWild, wType, tb1, tb2, tb3, tb4, tb5, name="nOfType"))## Joining with `by = join_by(nWild, wType, tb1, tb2, tb3, tb4, tb5)`# Chart of overall probabilities by bet amount
dfResAll_202301_v001 %>%
summarize(n=sum(nOfType),
across(c(pWNoTie, evAnte, evPlay, evBlind, evAll), .fns=function(x) sum(x*nOfType)/sum(nOfType))
)## # A tibble: 1 × 6
## n pWNoTie evAnte evPlay evBlind evAll
## <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 2869685 0.500 -0.274 0.457 -0.259 -0.0757# Chart of probabilities by bet amount
dfResAll_202301_v001 %>%
group_by(betPlay) %>%
summarize(n=sum(nOfType),
minPw=min(pWNoTie),
across(c(pWNoTie, evAnte, evPlay, evBlind, evAll), .fns=function(x) sum(x*nOfType)/sum(nOfType))
)## # A tibble: 3 × 8
## betPlay n minPw pWNoTie evAnte evPlay evBlind evAll
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0 743580 0 0.123 -1 0 -1 -2
## 2 1 683520 0.250 0.359 -0.547 -0.282 -0.641 -1.47
## 3 2 1442585 0.500 0.761 0.230 1.04 0.304 1.58# Plot of win probabilities
dfResAll_202301_v001 %>%
arrange(pWNoTie) %>%
mutate(cs=cumsum(nOfType)) %>%
ggplot(aes(x=cs/choose(53, 5), y=pWNoTie)) +
geom_line() +
geom_point(data=tibble::tibble(x=c(0, 0.25, 0.5, 1), col=c("black", "red", "green", "black")) %>% mutate(y=x),
aes(x=x, y=y, color=col),
size=3
) +
scale_color_identity() +
geom_abline(slope=1, intercept=0, lty=2) +
labs(title="Probability of winning based on 5-card hand",
x="5-card hand percentile",
y="Probability of winning (ties excluded)"
)
Volatility of the bonus bet is explored, assuming 100 hands:
nBonusPay <- allValueGrid %>%
select(n, bonusPay) %>%
filter(!is.na(n)) %>%
group_by(bonusPay) %>%
summarize(n=sum(n))
nBonusPay## # A tibble: 15 × 2
## bonusPay n
## <dbl> <int>
## 1 -1 2235900
## 2 1 415800
## 3 3 73824
## 4 4 13976
## 5 5 11880
## 6 6 93400
## 7 20 10176
## 8 25 8592
## 9 30 3168
## 10 60 528
## 11 70 1400
## 12 90 1000
## 13 200 36
## 14 1000 4
## 15 2000 1# Overall metrics - mean and standard deviation
nBonusPay %>%
summarize(evBonus=sum(bonusPay*n)/sum(n),
evBonus2=sum(n*(bonusPay**2))/sum(n)
) %>%
mutate(sdBonus=sqrt(evBonus2-evBonus**2))## # A tibble: 1 × 3
## evBonus evBonus2 sdBonus
## <dbl> <dbl> <dbl>
## 1 -0.0616 16.0 3.99# Simulations of 100 hands
set.seed(23013015)
nSims <- 10000
nPerSim <- 100
simTotal <- vector("numeric", length=nSims)
for(intCtr in 1:nSims) simTotal[intCtr] <- sum(sample(nBonusPay$bonusPay,
size=nPerSim,
prob=nBonusPay$n,
replace=TRUE
)
)
cat("\n",
nSims,
"simulations each of",
nPerSim,
"hands has mean:",
round(mean(simTotal), 2),
"with sd:",
round(sd(simTotal), 1),
"\n"
)##
## 10000 simulations each of 100 hands has mean: -5.72 with sd: 47# Plot of outcomes
tibble::tibble(result=simTotal) %>%
arrange(result) %>%
mutate(rn=row_number(), cummean=cumsum(result)/rn) %>%
ggplot(aes(x=(rn-1)/(max(rn)-1), y=cummean)) +
geom_point() +
labs(title=paste0("Mean return for ", nPerSim, " hands"),
x="Result percentile",
y="Cumulative mean return for hands through percentile"
)
# Quantiles and proportion greater than zero
quantile(simTotal, c(0, 0.01, 0.025, 0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95, 0.975, 0.99, 1))## 0% 1% 2.5% 5% 10% 25% 50% 75% 90% 95%
## -77.00 -61.00 -55.00 -50.00 -44.00 -31.00 -13.00 10.00 42.00 65.00
## 97.5% 99% 100%
## 85.00 110.01 2066.00cat("\n",
paste0(round(mean(simTotal>0)*100, 1), "%"),
"of simulations are wins, with mean win per winning simulation:",
round(mean(simTotal[simTotal>0]), 1),
"and median win per winning simulation:",
round(median(simTotal[simTotal>0]), 1)
)##
## 33.8% of simulations are wins, with mean win per winning simulation: 34.7 and median win per winning simulation: 24cat("\n",
paste0(round(mean(simTotal==0)*100, 1), "%"),
"of simulations are draws"
)##
## 0.8% of simulations are drawscat("\n",
paste0(round(mean(simTotal<0)*100, 1), "%"),
"of simulations are losers, with mean loss per losing simulation:",
round(mean(simTotal[simTotal<0]), 1),
"and median loss per losing simulation:",
round(median(simTotal[simTotal<0]), 1),
"\n"
)##
## 65.3% of simulations are losers, with mean loss per losing simulation: -26.7 and median loss per losing simulation: -26Volatility of the main bet is explored, assuming 100 hands:
dfHandData <- dfResAll_202301_v001 %>%
select(wType, nOfType, betPlay, starts_with("p")) %>%
mutate(win=pWQ+pWN, tie=pTQ+pTN, lose=pLQ+pLN, blindPay=blindPay[paste0("b_", wType)])
dfHandData## # A tibble: 7,309 × 14
## wType nOfType betPlay pLQ pLN pTQ pTN pWQ pWN pWNoTie win
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 11 1260 2 0.306 0 0.000232 0 0.397 0.297 0.694 0.694
## 2 11 1260 2 0.304 0 0.000232 0 0.399 0.297 0.696 0.696
## 3 11 1260 2 0.301 0 0.000232 0 0.402 0.297 0.699 0.699
## 4 11 1260 2 0.297 0 0.000232 0 0.406 0.297 0.703 0.703
## 5 11 1260 2 0.290 0 0.000232 0 0.413 0.297 0.710 0.710
## 6 11 1260 2 0.281 0 0.000232 0 0.422 0.297 0.719 0.719
## 7 11 1260 2 0.268 0 0.000232 0 0.435 0.297 0.732 0.732
## 8 11 1260 2 0.251 0 0.000232 0 0.452 0.297 0.749 0.749
## 9 11 1260 2 0.305 0 0.000232 0 0.398 0.297 0.695 0.695
## 10 11 1260 2 0.303 0 0.000232 0 0.399 0.297 0.697 0.697
## # … with 7,299 more rows, and 3 more variables: tie <dbl>, lose <dbl>,
## # blindPay <dbl>getHandOutcome <- function(pWQ, pWN, tie, lose, betPlay, blindPay) {
if(betPlay==0) return(tibble::tibble(result="fold", ante=-1, blind=-1, play=0))
result <- sample(c("win/qualify", "win/no qualify", "tie", "lose"),
size=1,
replace=TRUE,
prob=c(pWQ, pWN, tie, lose)
)
return(tibble::tibble(result=result,
ante=case_when(result=="win/qualify" ~ 1,
result %in% c("win/no qualify", "tie") ~ 0,
result=="lose" ~ -1,
TRUE ~ -99
),
blind=case_when(result %in% c("win/qualify", "win/no qualify") ~ blindPay,
result=="tie" ~ 0,
result=="lose" ~ -1,
TRUE ~ -99
),
play=case_when(result %in% c("win/qualify", "win/no qualify") ~ betPlay,
result=="tie" ~ 0,
result=="lose" ~ -betPlay,
TRUE ~ -99
)
)
)
}
lst200 <- lapply(1:200, FUN=function(y) {
map_dfr(1:100,
.f=function(x) {
rn <- sample(1:nrow(dfHandData), size=1, replace=TRUE, prob=dfHandData$nOfType)
rd <- dfHandData[rn,]
getHandOutcome(pWQ=rd$pWQ,
pWN=rd$pWN,
tie=rd$tie,
lose=rd$lose,
betPlay=rd$betPlay,
blindPay=rd$blindPay
) %>%
mutate(rn=rn, n=1)
}
)
}
)
res200 <- map_dfr(lst200, .f=function(x) summarize(x, across(c("ante", "blind", "play"), .fns=sum), n=n()))
res200## # A tibble: 200 × 4
## ante blind play n
## <dbl> <dbl> <dbl> <int>
## 1 -21 -27 62 100
## 2 -6 -23 76 100
## 3 -27 -34 42 100
## 4 -31 -42 36 100
## 5 -36 -39 48 100
## 6 -28 -14 40 100
## 7 -27 -32 45 100
## 8 -35 -32 39 100
## 9 -20 -36 64 100
## 10 -20 -30 54 100
## # … with 190 more rowsres200 %>%
mutate(overall=ante+blind+play) %>%
summarize(across(.fns=mean))## # A tibble: 1 × 5
## ante blind play n overall
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 -28.2 -26.3 44.6 100 -9.84The process is converted for parallel processing:
# Simulations of 100 hands
set.seed(23020115)
nSims <- 10000
nPerSim <- 100
simTotal <- vector("numeric", length=nSims)
# Get the hand numbers for the simulation
rn <- sample(1:nrow(dfHandData), size=nPerSim*nSims, replace=TRUE, prob=dfHandData$nOfType)
# Get the outcomes for the simulation
rd <- dfHandData[rn,] %>%
mutate(prob=runif(nPerSim*nSims),
wintie=win+tie,
res=case_when(prob<=pWQ ~ "winQ",
prob<=win ~ "winNo",
prob <= wintie ~ "tie",
prob <= wintie+lose ~ "lose",
TRUE ~ "ERROR"
)
)
# Convert to payouts by bet
rp <- rd %>%
mutate(resActual=ifelse(betPlay==0, "fold", res),
resPlay=case_when(resActual %in% c("winQ", "winNo") ~ betPlay,
resActual %in% c("fold", "tie") ~ 0,
resActual %in% c("lose") ~ -betPlay,
TRUE ~ -Inf
),
resBlind=case_when(resActual %in% c("winQ", "winNo") ~ blindPay,
resActual %in% c("tie") ~ 0,
resActual %in% c("lose", "fold") ~ -1,
TRUE ~ -Inf
),
resAnte=case_when(resActual %in% c("winQ") ~ 1,
resActual %in% c("tie", "winNo") ~ 0,
resActual %in% c("lose", "fold") ~ -1,
TRUE ~ -Inf
),
resAll=resPlay+resBlind+resAnte
) %>%
select(wType, betPlay, res, resActual, resPlay, resBlind, resAnte, resAll)
rp## # A tibble: 1,000,000 × 8
## wType betPlay res resActual resPlay resBlind resAnte resAll
## <dbl> <dbl> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 11 2 lose lose -2 -1 -1 -4
## 2 8 2 winQ winQ 2 2 1 5
## 3 99 0 lose fold 0 -1 -1 -2
## 4 11 2 winQ winQ 2 0 1 3
## 5 10 2 winNo winNo 2 0 0 2
## 6 9 2 winNo winNo 2 0 0 2
## 7 11 2 lose lose -2 -1 -1 -4
## 8 11 2 lose lose -2 -1 -1 -4
## 9 11 1 lose lose -1 -1 -1 -3
## 10 9 2 winQ winQ 2 0 1 3
## # … with 999,990 more rows# Get statistics by key attributes
rp %>%
summarize(n=n(), across(c(resPlay, resBlind, resAnte, resAll), .fns=mean))## # A tibble: 1 × 5
## n resPlay resBlind resAnte resAll
## <int> <dbl> <dbl> <dbl> <dbl>
## 1 1000000 0.457 -0.254 -0.274 -0.0709rp %>%
group_by(wType, betPlay) %>%
summarize(n=n(), across(c(resPlay, resBlind, resAnte, resAll), .fns=mean), .groups="drop") %>%
arrange(desc(wType), betPlay)## # A tibble: 14 × 7
## wType betPlay n resPlay resBlind resAnte resAll
## <dbl> <dbl> <int> <dbl> <dbl> <dbl> <dbl>
## 1 99 0 259500 0 -1 -1 -2
## 2 99 1 19608 -0.495 -0.748 -0.748 -1.99
## 3 11 1 218048 -0.261 -0.630 -0.527 -1.42
## 4 11 2 248743 0.541 -0.365 -0.0166 0.159
## 5 10 2 33267 0.956 -0.261 0.222 0.917
## 6 9 2 159596 1.51 -0.123 0.455 1.84
## 7 8 2 29385 1.85 1.88 0.616 4.35
## 8 7 2 6699 1.90 2.90 0.639 5.44
## 9 6 2 5287 1.91 3.89 0.669 6.47
## 10 5 2 17688 1.98 4.97 0.660 7.61
## 11 4 2 1307 2.00 25.0 0.657 27.6
## 12 3 2 500 2 40 0.624 42.6
## 13 2 2 370 2 100 0.649 103.
## 14 1 2 2 2 2000 0.5 2002.rp %>%
group_by(wType, resActual) %>%
summarize(n=n(), across(c(resPlay, resBlind, resAnte, resAll), .fns=mean), .groups="drop") %>%
arrange(desc(wType), resActual) %>%
print(n=40)## # A tibble: 37 × 7
## wType resActual n resPlay resBlind resAnte resAll
## <dbl> <chr> <int> <dbl> <dbl> <dbl> <dbl>
## 1 99 fold 259500 0 -1 -1 -2
## 2 99 lose 14660 -1 -1 -1 -3
## 3 99 tie 3 0 0 0 0
## 4 99 winNo 4945 1 0 0 1
## 5 11 lose 228193 -1.40 -1 -1 -3.40
## 6 11 tie 67 0 0 0 0
## 7 11 winNo 129395 1.55 0 0 1.55
## 8 11 winQ 109136 1.79 0 1 2.79
## 9 10 lose 8682 -2 -1 -1 -4
## 10 10 winNo 8508 2 0 0 2
## 11 10 winQ 16077 2 0 1 3
## 12 9 lose 19582 -2 -1 -1 -4
## 13 9 tie 11 0 0 0 0
## 14 9 winNo 47842 2 0 0 2
## 15 9 winQ 92161 2 0 1 3
## 16 8 lose 1094 -2 -1 -1 -4
## 17 8 tie 49 0 0 0 0
## 18 8 winNo 9042 2 2 0 4
## 19 8 winQ 19200 2 2 1 5
## 20 7 lose 164 -2 -1 -1 -4
## 21 7 winNo 2093 2 3 0 5
## 22 7 winQ 4442 2 3 1 6
## 23 6 lose 119 -2 -1 -1 -4
## 24 6 winNo 1513 2 4 0 6
## 25 6 winQ 3655 2 4 1 7
## 26 5 lose 87 -2 -1 -1 -4
## 27 5 winNo 5848 2 5 0 7
## 28 5 winQ 11753 2 5 1 8
## 29 4 lose 1 -2 -1 -1 -4
## 30 4 winNo 446 2 25 0 27
## 31 4 winQ 860 2 25 1 28
## 32 3 winNo 188 2 40 0 42
## 33 3 winQ 312 2 40 1 43
## 34 2 winNo 130 2 100 0 102
## 35 2 winQ 240 2 100 1 103
## 36 1 winNo 1 2 2000 0 2002
## 37 1 winQ 1 2 2000 1 2003rp %>%
group_by(betPlay, resActual, res) %>%
summarize(n=n(),
across(c(resPlay, resBlind, resAnte, resAll), .fns=list(mean=mean)),
.groups="drop"
) %>%
arrange(betPlay)## # A tibble: 11 × 8
## betPlay resActual res n resPlay_mean resBlind_mean resAnte_m…¹ resAl…²
## <dbl> <chr> <chr> <int> <dbl> <dbl> <dbl> <dbl>
## 1 0 fold lose 227552 0 -1 -1 -2
## 2 0 fold tie 35 0 -1 -1 -2
## 3 0 fold winNo 31913 0 -1 -1 -2
## 4 1 lose lose 152121 -1 -1 -1 -3
## 5 1 tie tie 16 0 0 0 0
## 6 1 winNo winNo 62986 1 0 0 1
## 7 1 winQ winQ 22533 1 0 1 2
## 8 2 lose lose 120461 -2 -1 -1 -4
## 9 2 tie tie 114 0 0 0 0
## 10 2 winNo winNo 146965 2 0.635 0 2.64
## 11 2 winQ winQ 235304 2 0.787 1 3.79
## # … with abbreviated variable names ¹resAnte_mean, ²resAll_meanThe value of holding a specific card (no other values known) is explored:
# Full database of hands and outcomes
fullHandDB <- sortedHandRanks %>%
select(handNum, rank, qual, nWild) %>%
full_join(select(dfResAll_202301_v001, -handNum), by=c("rank", "nWild")) %>%
mutate(nType=tblAllTypes$nType) %>%
left_join(select(allValueGrid, wType=wildType, nType=naturalType, bonusPay), by=c("wType", "nType"))
fullHandDB## # A tibble: 2,869,685 × 28
## handNum rank qual nWild src pLQ pLN pTQ pTN pWQ pWN
## <int> <dbl> <chr> <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 22 Q 1 Straight F… 0.00156 0 5.96e-5 0 0.702 0.297
## 2 2 404 Q 1 Straight t… 0.0243 0 1.58e-5 0 0.679 0.297
## 3 3 401 Q 1 Straight t… 0.0243 0 1.58e-5 0 0.679 0.297
## 4 4 395 Q 1 Straight t… 0.0242 0 2.63e-5 0 0.679 0.297
## 5 5 385 Q 1 Straight t… 0.0240 0 2.63e-5 0 0.679 0.297
## 6 6 370 Q 1 Straight t… 0.0236 0 2.63e-5 0 0.679 0.297
## 7 7 349 Q 1 Straight t… 0.0231 0 2.63e-5 0 0.680 0.297
## 8 8 321 Q 1 Straight t… 0.0224 0 4.38e-5 0 0.681 0.297
## 9 9 321 Q 1 Straight t… 0.0224 0 4.38e-5 0 0.681 0.297
## 10 10 1134 Q 1 Two Pair o… 0.0639 0 2.10e-5 0 0.643 0.293
## # … with 2,869,675 more rows, and 17 more variables: n <int>, pWNoTie <dbl>,
## # type <dbl>, betPlay <dbl>, evAnte <dbl>, evPlay <dbl>, evBlind <dbl>,
## # evAll <dbl>, wType <dbl>, tb1 <dbl>, tb2 <dbl>, tb3 <dbl>, tb4 <dbl>,
## # tb5 <dbl>, nOfType <int>, nType <dbl>, bonusPay <dbl># Average bonus value given presence of card in hand
cardBonusValue <- map_dfr(.x=1:53,
.f=function(x) fullHandDB %>%
mutate(keyHand=ifelse(handNum %in% cardInHand[[x]], "Y", "N")) %>%
group_by(keyHand) %>%
summarize(n=n(), ev=mean(bonusPay), pctWin=mean(bonusPay>0)),
.id="cardNum"
)# Check that values are suit independent
map_dfr(.x=1:13,
.f=function(x) cardBonusValue %>%
filter(as.integer(cardNum) %in% (x+c(0, 13, 26, 39))) %>%
group_by(keyHand) %>%
summarize(across(where(is.numeric), .fns=function(x) max(x)-min(x))),
.id="cardRank"
) %>%
summary()## cardRank keyHand n ev
## Length:26 Length:26 Min. :0 Min. :0.000e+00
## Class :character Class :character 1st Qu.:0 1st Qu.:5.551e-17
## Mode :character Mode :character Median :0 Median :8.327e-17
## Mean :0 Mean :1.999e-16
## 3rd Qu.:0 3rd Qu.:2.064e-16
## Max. :0 Max. :1.388e-15
## pctWin
## Min. :0
## 1st Qu.:0
## Median :0
## Mean :0
## 3rd Qu.:0
## Max. :0# Show hand values
cardBonusValue %>%
filter(as.integer(cardNum) %in% c(1:13, 53)) %>%
select(haveCard=keyHand, cardNum, ev, winProb=pctWin) %>%
pivot_longer(-c(haveCard, cardNum)) %>%
mutate(haveCard=ifelse(haveCard=="Y", "1. First card is this", "2. First card is NOT this")) %>%
ggplot(aes(x=fct_reorder(cardNum,
value,
.fun=function(x) x[order(x, decreasing=TRUE)[2]] + min(x)/100
)
)
) +
geom_point(aes(y=value)) +
geom_text(aes(y=value+0.01, label=round(value, 3)), size=2.5, hjust=0) +
coord_flip() +
facet_grid(haveCard~name, scales="free_x") +
labs(title="Expected value of bonus given single card in hand", y="Average", x="Card Index")
As expected, wild cards are very valuable and make bonus hands much more likely. The deuce is more valuable than the joker since it can make higher-paying natural straights and flushes. Of the non-wild cards, 10 is most valuable (can make any straight, including royal), followed by 7-8-9 (can make any straight, naturally or wild)
The value of holding a specific card (no other values known) is explored:
# Average bonus value given presence of card in hand
cardMainValue <- map_dfr(.x=1:53,
.f=function(x) fullHandDB %>%
mutate(keyHand=ifelse(handNum %in% cardInHand[[x]], "Y", "N")) %>%
group_by(keyHand, betPlay) %>%
summarize(n=n(),
across(c(pLQ, pLN, pTQ, pTN, pWQ, pWN, evPlay, evAll), .fns=mean),
.groups="drop"
),
.id="cardNum"
)# Check that values are suit independent
map_dfr(.x=1:13,
.f=function(x) cardMainValue %>%
filter(as.integer(cardNum) %in% (x+c(0, 13, 26, 39))) %>%
group_by(keyHand, betPlay) %>%
summarize(across(where(is.numeric), .fns=function(x) max(x)-min(x)), .groups="drop"),
.id="cardRank"
) %>%
summary()## cardRank keyHand betPlay n
## Length:77 Length:77 Min. :0.000 Min. :0
## Class :character Class :character 1st Qu.:0.000 1st Qu.:0
## Mode :character Mode :character Median :1.000 Median :0
## Mean :1.013 Mean :0
## 3rd Qu.:2.000 3rd Qu.:0
## Max. :2.000 Max. :0
## pLQ pLN pTQ
## Min. :0.000e+00 Min. :0.000e+00 Min. :0.000e+00
## 1st Qu.:0.000e+00 1st Qu.:0.000e+00 1st Qu.:0.000e+00
## Median :0.000e+00 Median :0.000e+00 Median :0.000e+00
## Mean :9.012e-18 Mean :1.094e-18 Mean :3.344e-21
## 3rd Qu.:0.000e+00 3rd Qu.:0.000e+00 3rd Qu.:0.000e+00
## Max. :1.110e-16 Max. :2.776e-17 Max. :2.711e-20
## pTN pWQ pWN
## Min. :0.000e+00 Min. :0.000e+00 Min. :0.000e+00
## 1st Qu.:0.000e+00 1st Qu.:0.000e+00 1st Qu.:0.000e+00
## Median :0.000e+00 Median :0.000e+00 Median :0.000e+00
## Mean :2.970e-22 Mean :5.227e-18 Mean :2.523e-18
## 3rd Qu.:0.000e+00 3rd Qu.:0.000e+00 3rd Qu.:0.000e+00
## Max. :1.355e-20 Max. :5.551e-17 Max. :5.551e-17
## evPlay evAll
## Min. :0.000e+00 Min. :0.000e+00
## 1st Qu.:0.000e+00 1st Qu.:0.000e+00
## Median :0.000e+00 Median :0.000e+00
## Mean :8.651e-18 Mean :2.884e-17
## 3rd Qu.:0.000e+00 3rd Qu.:0.000e+00
## Max. :2.220e-16 Max. :4.441e-16# Show play bet size probabilities by initial card
cardMainValue %>%
filter(as.integer(cardNum) %in% c(1:13, 53), keyHand=="Y") %>%
group_by(cardNum) %>%
mutate(pct=n/sum(n), cumpct=cumsum(pct)-pct/2) %>%
ungroup() %>%
ggplot(aes(x=factor(cardNum, levels=c(53, 2, 1, 13:3)))) +
geom_col(aes(y=pct, fill=fct_rev(factor(betPlay))), position="fill") +
geom_text(aes(y=cumpct, label=round(pct,3)), size=2.5) +
labs(title="Play bet size by initial card", x="Initial card", y="Frequency") +
scale_fill_discrete("Play Bet")
# Show main bet EV by initial card and bet amount
cardMainValue %>%
filter(as.integer(cardNum) %in% c(1:13, 53), keyHand=="Y") %>%
group_by(cardNum) %>%
summarize(across(c(evPlay, evAll), .fns=function(x) sum(x*n)/sum(n)), .groups="drop") %>%
pivot_longer(-c(cardNum)) %>%
ggplot(aes(x=factor(cardNum, levels=c(3:13, 1, 2, 53)))) +
geom_col(aes(y=value), fill="lightblue") +
geom_text(aes(y=value/2, label=round(value,3)), size=2.5) +
labs(title="EV by initial card", x="Initial card", y="EV") +
coord_flip() +
facet_wrap(~name)
# Show main bet EV by initial card and bet amount
cardMainValue %>%
filter(as.integer(cardNum) %in% c(1:13, 53), keyHand=="Y") %>%
select(cardNum, betPlay, evPlay, evAll) %>%
pivot_longer(-c(cardNum, betPlay)) %>%
ggplot(aes(x=factor(cardNum, levels=c(3:13, 1, 2, 53)))) +
geom_col(aes(y=value), fill="lightblue") +
geom_text(aes(y=value/2, label=round(value,3)), size=2.5) +
labs(title="EV by initial card and bet size", x="Initial card", y="EV") +
coord_flip() +
facet_grid(betPlay~name)
The overall value of holding a specific card (no other values known) is explored:
# Show play bet size probabilities by initial card
cardMainValue %>%
filter(as.integer(cardNum) %in% c(1:13, 53), keyHand=="Y") %>%
group_by(cardNum, keyHand) %>%
summarize(across(c(evPlay, evAll), .fns=function(x) sum(x*n)/sum(n)), .groups="drop") %>%
full_join(filter(select(cardBonusValue, -n), keyHand=="Y", as.integer(cardNum) %in% c(1:13, 53)),
by=c("cardNum", "keyHand")
) %>%
rename(evBonus=ev, pctWinBouns=pctWin, evMainAll=evAll) %>%
mutate(evOverAll3_1=3*evMainAll+evBonus) %>%
select(cardNum, keyHand, evMainAll, evBonus, evOverAll3_1) %>%
pivot_longer(-c(cardNum, keyHand)) %>%
ggplot(aes(x=factor(cardNum, levels=c(2, 53, 1, 13:3)))) +
geom_col(aes(y=value), fill="lightblue") +
geom_text(aes(y=value, label=round(value,2), hjust=ifelse(value<0, 1, 0)), size=2.5) +
labs(title="EV by initial card", x="Initial card", y="EV") +
coord_flip() +
facet_wrap(~name)
The value of holding both a wild card and a specific card (no other values known) is explored:
# Average bonus value given presence of card in hand
cardWithWildValue <- map_dfr(.x=c(1:52),
.f=function(x) fullHandDB %>%
mutate(keyHand=ifelse(handNum %in% intersect(cardInHand[[x]], cardInHand[[53]]),
"Y",
"N"
)
) %>%
group_by(keyHand, betPlay) %>%
summarize(n=n(),
across(c(pLQ, pLN, pTQ, pTN, pWQ, pWN, evPlay, evAll), .fns=mean),
.groups="drop"
),
.id="cardNum"
)# Check that values are suit independent
map_dfr(.x=1:13,
.f=function(x) cardWithWildValue %>%
filter(as.integer(cardNum) %in% (x+c(0, 13, 26, 39))) %>%
group_by(keyHand, betPlay) %>%
summarize(across(where(is.numeric), .fns=function(x) max(x)-min(x)), .groups="drop"),
.id="cardRank"
) %>%
summary()## cardRank keyHand betPlay n
## Length:60 Length:60 Min. :0.000 Min. :0
## Class :character Class :character 1st Qu.:1.000 1st Qu.:0
## Mode :character Mode :character Median :1.000 Median :0
## Mean :1.217 Mean :0
## 3rd Qu.:2.000 3rd Qu.:0
## Max. :2.000 Max. :0
## pLQ pLN pTQ pTN
## Min. :0.000e+00 Min. :0 Min. :0.000e+00 Min. :0
## 1st Qu.:0.000e+00 1st Qu.:0 1st Qu.:0.000e+00 1st Qu.:0
## Median :0.000e+00 Median :0 Median :0.000e+00 Median :0
## Mean :1.388e-18 Mean :0 Mean :2.598e-21 Mean :0
## 3rd Qu.:0.000e+00 3rd Qu.:0 3rd Qu.:0.000e+00 3rd Qu.:0
## Max. :2.776e-17 Max. :0 Max. :2.711e-20 Max. :0
## pWQ pWN evPlay evAll
## Min. :0.000e+00 Min. :0 Min. :0.000e+00 Min. :0.000e+00
## 1st Qu.:0.000e+00 1st Qu.:0 1st Qu.:0.000e+00 1st Qu.:0.000e+00
## Median :0.000e+00 Median :0 Median :0.000e+00 Median :0.000e+00
## Mean :2.776e-18 Mean :0 Mean :8.327e-18 Mean :7.401e-18
## 3rd Qu.:0.000e+00 3rd Qu.:0 3rd Qu.:0.000e+00 3rd Qu.:0.000e+00
## Max. :5.551e-17 Max. :0 Max. :2.220e-16 Max. :2.220e-16# Show play bet size probabilities by second card
cardWithWildValue %>%
filter(as.integer(cardNum) %in% c(1:13), keyHand=="Y") %>%
group_by(cardNum) %>%
mutate(pct=n/sum(n), cumpct=cumsum(pct)-pct/2) %>%
ungroup() %>%
ggplot(aes(x=factor(cardNum, levels=c(2, 1, 13:3)))) +
geom_col(aes(y=pct, fill=fct_rev(factor(betPlay))), position="fill") +
geom_text(aes(y=cumpct, label=round(pct,3)), size=2.5) +
labs(title="Play bet size by second card given first card joker", x="Second card", y="Frequency") +
scale_fill_discrete("Play Bet")
# Show main bet EV by second card and bet amount
cardWithWildValue %>%
filter(as.integer(cardNum) %in% c(1:13), keyHand=="Y") %>%
group_by(cardNum) %>%
summarize(across(c(evPlay, evAll), .fns=function(x) sum(x*n)/sum(n)), .groups="drop") %>%
pivot_longer(-c(cardNum)) %>%
ggplot(aes(x=factor(cardNum, levels=c(3:13, 1, 2)))) +
geom_col(aes(y=value), fill="lightblue") +
geom_text(aes(y=value/2, label=round(value,3)), size=2.5) +
labs(title="EV by second card given first card joker", x="Second card", y="EV") +
coord_flip() +
facet_wrap(~name)
# Show main bet EV by second card and bet amount
cardWithWildValue %>%
filter(as.integer(cardNum) %in% c(1:13), keyHand=="Y") %>%
select(cardNum, betPlay, evPlay, evAll) %>%
pivot_longer(-c(cardNum, betPlay)) %>%
ggplot(aes(x=factor(cardNum, levels=c(3:13, 1, 2)))) +
geom_col(aes(y=value), fill="lightblue") +
geom_text(aes(y=value/2, label=round(value,3)), size=2.5) +
labs(title="EV by second card (assumes first is joker) and bet size", x="Second card", y="EV") +
coord_flip() +
facet_grid(betPlay~name)
The value of holding two cards (not each of the same suit) is explored:
# Average main value given presence of two unsuited cards in hand
cardFirstTwoValue <- map2(.x=rep(1:13, each=13),
.y=rep(14:26, times=13),
.f=function(x, y) fullHandDB %>%
mutate(keyHand=ifelse(handNum %in% intersect(cardInHand[[x]], cardInHand[[y]]),
"Y",
"N"
),
card1=x,
card2=y
) %>%
group_by(keyHand, betPlay, card1, card2) %>%
summarize(n=n(),
across(c(pLQ, pLN, pTQ, pTN, pWQ, pWN, evPlay, evAll), .fns=mean),
.groups="drop"
)
)# Show play bet size probabilities by first two cards
cardFirstTwoValue %>%
list_rbind() %>%
filter(card1 != card2, keyHand=="Y") %>%
group_by(card1, card2) %>%
mutate(pct=n/sum(n)) %>%
ungroup() %>%
ggplot(aes(x=factor(card1, levels=c(2, 1, 13:3)), y=factor(card2, levels=c(15, 14, 26:16)))) +
geom_tile(aes(fill=pct)) +
geom_text(aes(label=round(pct,2)), size=2.5) +
labs(title="Frequency of bet size by first two cards (unsuited)", x="First card", y="Second card") +
facet_wrap(~betPlay) +
scale_fill_continuous("Proportion of hands", high="lightgreen", low="white") +
theme(legend.position = "bottom")
# Show main bet EV by second card
cardFirstTwoValue %>%
list_rbind() %>%
filter(card1 != card2, keyHand=="Y") %>%
group_by(card1, card2) %>%
summarize(across(c(evPlay, evAll), .fns=function(x) sum(x*n)/sum(n)), .groups="drop") %>%
pivot_longer(-c(card1, card2)) %>%
ggplot(aes(x=factor(card1, levels=c(2, 1, 13:3)), y=factor(card2, levels=c(15, 14, 26:16)))) +
geom_tile(aes(fill=value)) +
geom_text(aes(label=round(value,2)), size=2.5) +
labs(title="EV by first two cards (unsuited)", x="First card", y="Second card") +
facet_wrap(~name) +
scale_fill_continuous("EV", high="lightgreen", low="white")
# Show main bet EV by second card and bet amount
cardFirstTwoValue %>%
list_rbind() %>%
filter(card1 != card2, keyHand=="Y") %>%
select(card1, card2, betPlay, evPlay, evAll) %>%
pivot_longer(-c(card1, card2, betPlay)) %>%
ggplot(aes(x=factor(card1, levels=c(2, 1, 13:3)), y=factor(card2, levels=c(15, 14, 26:16)))) +
geom_tile(aes(fill=value)) +
geom_text(aes(label=round(value,2)), size=2.5) +
labs(title="EV by first two cards (unsuited) and bet size", x="First card", y="Second card") +
facet_grid(betPlay~name) +
scale_fill_continuous("EV", high="lightgreen", low="white")
The value of holding two cards (not each of the same suit) is explored:
# Average main value given presence of two unsuited cards in hand
cardFirstTwoSuitedValue <- map2(.x=rep(1:13, each=13),
.y=rep(1:13, times=13),
.f=function(x, y) fullHandDB %>%
mutate(keyHand=ifelse(handNum %in% intersect(cardInHand[[x]], cardInHand[[y]]),
"Y",
"N"
),
card1=x,
card2=y
) %>%
group_by(keyHand, betPlay, card1, card2) %>%
summarize(n=n(),
across(c(pLQ, pLN, pTQ, pTN, pWQ, pWN, evPlay, evAll), .fns=mean),
.groups="drop"
)
)# Show play bet size probabilities by first two cards (suited)
cardFirstTwoSuitedValue %>%
list_rbind() %>%
filter(card1 != card2, keyHand=="Y") %>%
group_by(card1, card2) %>%
mutate(pct=n/sum(n)) %>%
ungroup() %>%
ggplot(aes(x=factor(card1, levels=c(2, 1, 13:3)), y=factor(card2, levels=c(2, 1, 13:3)))) +
geom_tile(aes(fill=pct)) +
geom_text(aes(label=round(pct,2)), size=2.5) +
labs(title="Frequency of bet size by first two cards (suited)", x="First card", y="Second card") +
facet_wrap(~betPlay) +
scale_fill_continuous("Proportion of hands", high="lightgreen", low="white") +
theme(legend.position = "bottom")
# Show main bet EV by first two cards (suited)
cardFirstTwoSuitedValue %>%
list_rbind() %>%
filter(card1 != card2, keyHand=="Y") %>%
group_by(card1, card2) %>%
summarize(across(c(evPlay, evAll), .fns=function(x) sum(x*n)/sum(n)), .groups="drop") %>%
pivot_longer(-c(card1, card2)) %>%
ggplot(aes(x=factor(card1, levels=c(2, 1, 13:3)), y=factor(card2, levels=c(2, 1, 13:3)))) +
geom_tile(aes(fill=value)) +
geom_text(aes(label=round(value,2)), size=2.5) +
labs(title="EV by first two cards (suited)", x="First card", y="Second card") +
facet_wrap(~name) +
scale_fill_continuous("EV", high="lightgreen", low="white")
# Show main bet EV by first two cards (suited) and bet amount
cardFirstTwoSuitedValue %>%
list_rbind() %>%
filter(card1 != card2, keyHand=="Y") %>%
select(card1, card2, betPlay, evPlay, evAll) %>%
pivot_longer(-c(card1, card2, betPlay)) %>%
ggplot(aes(x=factor(card1, levels=c(2, 1, 13:3)), y=factor(card2, levels=c(2, 1, 13:3)))) +
geom_tile(aes(fill=value)) +
geom_text(aes(label=round(value,2)), size=2.5) +
labs(title="EV by first two cards (suited) and bet size", x="First card", y="Second card") +
facet_grid(betPlay~name) +
scale_fill_continuous("EV", high="lightgreen", low="white")
An attempt is made to improve the hand exclusion process. The cards by hand matrix is created:
# Matrix of 1/0 for whether card is in hand
fullHandMatrix <- matrix(rep(0L, 53*choose(53,5)), nrow=choose(53,5), ncol=53)
for(intCtr in 1:53) {
fullHandMatrix[cardInHand[[intCtr]], intCtr] <- 1L
}
colSums(fullHandMatrix)## [1] 270725 270725 270725 270725 270725 270725 270725 270725 270725 270725
## [11] 270725 270725 270725 270725 270725 270725 270725 270725 270725 270725
## [21] 270725 270725 270725 270725 270725 270725 270725 270725 270725 270725
## [31] 270725 270725 270725 270725 270725 270725 270725 270725 270725 270725
## [41] 270725 270725 270725 270725 270725 270725 270725 270725 270725 270725
## [51] 270725 270725 270725# Select a subset of fullHandMatrix to be the exclusions
t <- proc.time()
set.seed(23022216)
exclMatrix <- fullHandMatrix[sample(1:nrow(fullHandMatrix), 10, replace=FALSE), ]
# Matrix math of the exclusions, run row by row of exclMatrix
map(1:10,
.f=function(x)
sortedHandRanks[which((fullHandMatrix %*% t(exclMatrix[x,,drop=FALSE]))>0),] %>% count(rank)
) %>% str## List of 10
## $ : tibble [4,314 × 2] (S3: tbl_df/tbl/data.frame)
## ..$ rank: num [1:4314] 2 4 5 13 14 15 16 20 21 22 ...
## ..$ n : int [1:4314] 196 65 65 105 70 91 56 242 233 105 ...
## $ : tibble [4,679 × 2] (S3: tbl_df/tbl/data.frame)
## ..$ rank: num [1:4679] 2 6 8 9 13 14 15 16 17 18 ...
## ..$ n : int [1:4679] 126 65 70 70 70 70 177 233 168 112 ...
## $ : tibble [4,678 × 2] (S3: tbl_df/tbl/data.frame)
## ..$ rank: num [1:4678] 1 2 3 4 5 6 7 8 9 10 ...
## ..$ n : int [1:4678] 1 640 53 53 53 87 87 69 69 69 ...
## $ : tibble [4,679 × 2] (S3: tbl_df/tbl/data.frame)
## ..$ rank: num [1:4679] 2 4 6 7 9 13 15 16 17 18 ...
## ..$ n : int [1:4679] 322 65 65 65 70 70 147 233 168 112 ...
## $ : tibble [4,671 × 2] (S3: tbl_df/tbl/data.frame)
## ..$ rank: num [1:4671] 1 2 3 4 5 6 7 8 9 10 ...
## ..$ n : int [1:4671] 1 605 53 53 87 87 53 104 104 69 ...
## $ : tibble [4,314 × 2] (S3: tbl_df/tbl/data.frame)
## ..$ rank: num [1:4314] 2 6 8 11 13 15 16 17 18 19 ...
## ..$ n : int [1:4314] 252 95 70 70 70 177 147 147 121 91 ...
## $ : tibble [4,310 × 2] (S3: tbl_df/tbl/data.frame)
## ..$ rank: num [1:4310] 1 2 3 4 5 6 7 8 9 10 ...
## ..$ n : int [1:4310] 1 815 84 84 99 84 84 104 104 119 ...
## $ : tibble [3,729 × 2] (S3: tbl_df/tbl/data.frame)
## ..$ rank: num [1:3729] 1 2 3 4 5 6 7 8 9 10 ...
## ..$ n : int [1:3729] 1 780 84 84 84 84 84 104 104 104 ...
## $ : tibble [4,675 × 2] (S3: tbl_df/tbl/data.frame)
## ..$ rank: num [1:4675] 1 2 3 4 5 6 7 8 9 10 ...
## ..$ n : int [1:4675] 1 640 53 87 87 53 53 104 69 104 ...
## $ : tibble [4,675 × 2] (S3: tbl_df/tbl/data.frame)
## ..$ rank: num [1:4675] 1 2 3 4 5 6 7 8 9 10 ...
## ..$ n : int [1:4675] 1 605 53 53 87 53 87 104 69 104 ...proc.time() - t## user system elapsed
## 13.28 6.92 31.18# Existing process
t <- proc.time()
calculateResults(useHandNums=1:10)## # A tibble: 10 × 16
## pLQ pLN pTQ pTN pWQ pWN n pWNoTie rank type handNum
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl> <int>
## 1 0.00156 0 0.0000596 0 0.702 0.297 1712304 0.998 22 4 1
## 2 0.0243 0 0.0000158 0 0.679 0.297 1712304 0.976 404 7 2
## 3 0.0243 0 0.0000158 0 0.679 0.297 1712304 0.976 401 7 3
## 4 0.0242 0 0.0000263 0 0.679 0.297 1712304 0.976 395 7 4
## 5 0.0240 0 0.0000263 0 0.679 0.297 1712304 0.976 385 7 5
## 6 0.0236 0 0.0000263 0 0.679 0.297 1712304 0.976 370 7 6
## 7 0.0231 0 0.0000263 0 0.680 0.297 1712304 0.977 349 7 7
## 8 0.0224 0 0.0000438 0 0.681 0.297 1712304 0.978 321 7 8
## 9 0.0224 0 0.0000438 0 0.681 0.297 1712304 0.978 321 7 9
## 10 0.0639 0 0.0000210 0 0.643 0.293 1712304 0.936 1134 9 10
## # … with 5 more variables: betPlay <dbl>, evAnte <dbl>, evPlay <dbl>,
## # evBlind <dbl>, evAll <dbl>proc.time() - t## user system elapsed
## 8.08 2.27 13.76cat("\nThe existing process would take around", round(choose(53,5) * 5 / 10 / 60), "minutes for all hands\n")##
## The existing process would take around 23914 minutes for all handsWhile slow, the existing process is much faster than the attempted conversion to matrix math. Further exploration can potentially focus on optimizing calculateResults() and downstream functions:
# Timing impact for union of cards in hand (9 hands per second, 0.11 seconds per hand)
t <- proc.time()
for(intCtr in 1:100) tmp <- purrr::reduce(.x=cardInHand[c(1, 2, 3, 4, 5)], .f=union)
proc.time() - t## user system elapsed
## 16.70 3.97 24.21# Timing impact for finding hand values (2.5 hands per second, 0.4 seconds per hand)
tmpRank <- sortedHandRanks$rank[1]
t <- proc.time()
for(intCtr in 1:100) {
sortedHandRanks %>%
filter(!(handNum %in% tmp)) %>%
summarize(pLQ=mean(qual=="Q" & rank<tmpRank),
pLN=mean(qual=="N" & rank<tmpRank),
pTQ=mean(qual=="Q" & rank==tmpRank),
pTN=mean(qual=="N" & rank==tmpRank),
pWQ=mean(qual=="Q" & rank>tmpRank),
pWN=mean(qual=="N" & rank>tmpRank),
n=n()
) %>%
mutate(pWNoTie=(pWQ+pWN)/(1-pTQ-pTN), rank=tmpRank)
}
proc.time() - t## user system elapsed
## 51.00 16.74 72.89The function for assessing probabilities of win, tie, lose, and qualify takes ~80% of the time, and is a candidate for further exploration:
t <- proc.time()
for(intCtr in 1:100) {
sortedHandRanks %>%
filter(!(handNum %in% tmp)) %>%
mutate(result=case_when(rank < tmpRank ~ "L",
rank==tmpRank ~ "T",
rank > tmpRank ~ "W",
TRUE ~ "Error"
)
) %>%
count(qual, result)
}
proc.time() - t## user system elapsed
## 56.25 18.93 79.63t <- proc.time()
for(intCtr in 1:100) {
sortedHandRanks %>%
filter(!(handNum %in% tmp))
}
proc.time() - t## user system elapsed
## 23.16 11.20 36.48t <- proc.time()
for(intCtr in 1:100) {
smallSorted %>%
filter(!(handNum %in% tmp))
}
proc.time() - t## user system elapsed
## 20.22 5.84 26.77Creating a variable and then counting is slower than summarizing. A significant chunk of the time is in the filtering to only the relevant hands. Most of the time takes place in the actual filtering step, even if extraneous columns of the database are deleted
The total number of hands can be reduced by taking advantage of suit indifference (e.g., there are a hand has the same value if all its spades became hearts and all its hearts became spades). For hands with no wilds, there are the following combinations:
- 5-0-0-0 (flushes)
- 4-1-0-0
- 3-2-0-0
- 3-1-1-0
- 2-2-1-0
- 2-1-1-1
All hands of a given type can be simulated using the first suit for the maximum number of cards:
# Get count by suit for each hand type
handSuit <- tibble::tibble(handNum=1:nrow(mtxHands),
nWild=mtxHands %in% c(2, 15, 28, 41, 53) %>% matrix(ncol=5, byrow=FALSE) %>% rowSums,
n1=mtxHands %in% c(1, 3:13) %>% matrix(ncol=5, byrow=FALSE) %>% rowSums,
n2=mtxHands %in% c(14, 16:26) %>% matrix(ncol=5, byrow=FALSE) %>% rowSums,
n3=mtxHands %in% c(27, 29:39) %>% matrix(ncol=5, byrow=FALSE) %>% rowSums,
n4=mtxHands %in% c(40, 42:52) %>% matrix(ncol=5, byrow=FALSE) %>% rowSums
)
handSuit## # A tibble: 2,869,685 × 6
## handNum nWild n1 n2 n3 n4
## <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 1 4 0 0 0
## 2 2 1 4 0 0 0
## 3 3 1 4 0 0 0
## 4 4 1 4 0 0 0
## 5 5 1 4 0 0 0
## 6 6 1 4 0 0 0
## 7 7 1 4 0 0 0
## 8 8 1 4 0 0 0
## 9 9 1 4 0 0 0
## 10 10 1 3 1 0 0
## # … with 2,869,675 more rows# Filter for only descending order
handSuit %>%
filter(n2 <= n1, n3 <= n2, n4 <= n3) %>%
count(nWild, n1, n2, n3, n4)## # A tibble: 18 × 6
## nWild n1 n2 n3 n4 n
## <dbl> <dbl> <dbl> <dbl> <dbl> <int>
## 1 0 2 1 1 1 114048
## 2 0 2 2 1 0 52272
## 3 0 3 1 1 0 31680
## 4 0 3 2 0 0 14520
## 5 0 4 1 0 0 5940
## 6 0 5 0 0 0 792
## 7 1 1 1 1 1 103680
## 8 1 2 1 1 0 47520
## 9 1 2 2 0 0 21780
## 10 1 3 1 0 0 13200
## 11 1 4 0 0 0 2475
## 12 2 1 1 1 0 17280
## 13 2 2 1 0 0 7920
## 14 2 3 0 0 0 2200
## 15 3 1 1 0 0 1440
## 16 3 2 0 0 0 660
## 17 4 1 0 0 0 60
## 18 5 0 0 0 0 1There is still significant duplication in this data, as 4s-3s-A-K-Q and 4s-3s-K-A-Q are the same for 2-1-1-1. But just this initial filtering reduces the volume to simulate by a factor of 6-7. As an example, the natural hands with no pair that are A-K-J-x-x are explored:
# Key hands to use - Filter for only descending order
handEligible <- handSuit %>%
filter(n2 <= n1, n3 <= n2, n4 <= n3)
handEligible## # A tibble: 437,468 × 6
## handNum nWild n1 n2 n3 n4
## <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 1 4 0 0 0
## 2 2 1 4 0 0 0
## 3 3 1 4 0 0 0
## 4 4 1 4 0 0 0
## 5 5 1 4 0 0 0
## 6 6 1 4 0 0 0
## 7 7 1 4 0 0 0
## 8 8 1 4 0 0 0
## 9 9 1 4 0 0 0
## 10 10 1 3 1 0 0
## # … with 437,458 more rows# Eligible hands of type AKJxx
eligibleAKJxx <- allHandRanks %>%
filter(wType==99, tb1==14, tb2==13, tb3 == 11) %>%
semi_join(handEligible, by=c("handNum"))
eligibleAKJxx## # A tibble: 3,500 × 9
## handNum wType tb1 tb2 tb3 tb4 tb5 chgRank rank
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 121745 99 14 13 11 10 9 1 4415
## 2 121824 99 14 13 11 10 9 0 4415
## 3 122200 99 14 13 11 10 9 0 4415
## 4 122213 99 14 13 11 10 9 0 4415
## 5 122266 99 14 13 11 10 9 0 4415
## 6 122684 99 14 13 11 10 9 0 4415
## 7 123032 99 14 13 11 10 9 0 4415
## 8 123045 99 14 13 11 10 9 0 4415
## 9 123126 99 14 13 11 10 9 0 4415
## 10 124630 99 14 13 11 10 9 0 4415
## # … with 3,490 more rows# Create tibble of hand types
mtxSmallTest <- mtxHands[eligibleAKJxx$handNum,]
tblSmallTest <- tibble::as_tibble(mtxSmallTest, .name_repair=make.names) %>%
purrr::set_names(paste0("V", 1:5)) %>%
mutate(handNum=eligibleAKJxx$handNum)
tblSmallTest## # A tibble: 3,500 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 9 10 11 26 121745
## 2 1 9 10 13 24 121824
## 3 1 9 10 24 26 122200
## 4 1 9 10 24 39 122213
## 5 1 9 10 26 37 122266
## 6 1 9 11 13 23 122684
## 7 1 9 11 23 26 123032
## 8 1 9 11 23 39 123045
## 9 1 9 11 26 36 123126
## 10 1 9 13 23 24 124630
## # … with 3,490 more rows# Get suit counts of descending cards
tmpCheckSuits <- tblSmallTest %>%
pivot_longer(-c(handNum)) %>%
mutate(rank=1 + (value-1) %% 13, rank=ifelse(rank==1, 14, rank), suit=(value-1) %/% 13) %>%
arrange(handNum, desc(rank))
tmpCheckSuits## # A tibble: 17,500 × 5
## handNum name value rank suit
## <int> <chr> <int> <dbl> <dbl>
## 1 21113 V1 1 14 0
## 2 21113 V5 26 13 1
## 3 21113 V4 11 11 0
## 4 21113 V3 4 4 0
## 5 21113 V2 3 3 0
## 6 21192 V1 1 14 0
## 7 21192 V4 13 13 0
## 8 21192 V5 24 11 1
## 9 21192 V3 4 4 0
## 10 21192 V2 3 3 0
## # … with 17,490 more rows# Get count of hands with Ace as first suit, King as first or second suit - 1,120 hands
tmpAKJxxUse <- tmpCheckSuits %>%
filter((rank==14 & suit==0) | (rank==13 & suit %in% c(0, 1))) %>%
group_by(handNum) %>%
summarize(n=n()) %>%
filter(n==2)
tmpAKJxxUse## # A tibble: 1,120 × 2
## handNum n
## <int> <int>
## 1 21113 2
## 2 21192 2
## 3 21568 2
## 4 21634 2
## 5 22241 2
## 6 22320 2
## 7 22696 2
## 8 22762 2
## 9 23322 2
## 10 23401 2
## # … with 1,110 more rows# Run for example hand of AKJxx that have A as suit 1 and K as suit 1 or 2
t <- proc.time()
resAKJxx <- calculateResults(useHandNums=tmpAKJxxUse$handNum)
proc.time()-t## user system elapsed
## 535.17 121.46 664.25# Plot of EV by hand type
resAKJxx %>%
mutate(evAllIfPlay=2*pWQ+pWN-3*pLQ-3*pLN) %>%
left_join(tmpCheckSuits %>%
filter(!(rank %in% c(14, 13, 11))) %>%
group_by(handNum) %>%
mutate(label=paste0("AKJ", max(rank), min(rank)), label=str_replace(label, "10", "T")) %>%
filter(row_number()==1) %>%
ungroup(),
by="handNum"
) %>%
ggplot(aes(x=factor(label))) +
coord_flip() +
labs(x=NULL,
y="Distribution",
title="EV if playing hands of type 99, ranks AKJxx",
subtitle="Fold is EV -2"
) +
geom_boxplot(aes(y=evAllIfPlay), fill="lightblue") +
geom_hline(yintercept=-2, lty=2)
Significant reductions in processing time can be achieved through systemizing an approach like this. Additional hand types of Ace-high are also explored:
# Eligible hands of type AKxxx (excluding AKJxx, already created)
eligibleAKxxx <- allHandRanks %>%
filter(wType==99, tb1==14, tb2==13, tb3 != 11) %>%
semi_join(handEligible, by=c("handNum"))
eligibleAKxxx## # A tibble: 11,375 × 9
## handNum wType tb1 tb2 tb3 tb4 tb5 chgRank rank
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 122647 99 14 13 12 11 9 1 4380
## 2 122686 99 14 13 12 11 9 0 4380
## 3 123089 99 14 13 12 11 9 0 4380
## 4 123102 99 14 13 12 11 9 0 4380
## 5 123128 99 14 13 12 11 9 0 4380
## 6 123505 99 14 13 12 11 9 0 4380
## 7 123881 99 14 13 12 11 9 0 4380
## 8 123894 99 14 13 12 11 9 0 4380
## 9 123947 99 14 13 12 11 9 0 4380
## 10 124660 99 14 13 12 11 9 0 4380
## # … with 11,365 more rows# Create tibble of hand types
mtxSmallTest <- mtxHands[eligibleAKxxx$handNum,]
tblSmallTest <- tibble::as_tibble(mtxSmallTest, .name_repair=make.names) %>%
purrr::set_names(paste0("V", 1:5)) %>%
mutate(handNum=eligibleAKxxx$handNum)
tblSmallTest## # A tibble: 11,375 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 9 11 12 26 122647
## 2 1 9 11 13 25 122686
## 3 1 9 11 25 26 123089
## 4 1 9 11 25 39 123102
## 5 1 9 11 26 38 123128
## 6 1 9 12 13 24 123505
## 7 1 9 12 24 26 123881
## 8 1 9 12 24 39 123894
## 9 1 9 12 26 37 123947
## 10 1 9 13 24 25 124660
## # … with 11,365 more rows# Get suit counts of descending cards
tmpCheckSuits <- tblSmallTest %>%
pivot_longer(-c(handNum)) %>%
mutate(rank=1 + (value-1) %% 13, rank=ifelse(rank==1, 14, rank), suit=(value-1) %/% 13) %>%
arrange(handNum, desc(rank))
tmpCheckSuits## # A tibble: 56,875 × 5
## handNum name value rank suit
## <int> <chr> <int> <dbl> <dbl>
## 1 20846 V1 1 14 0
## 2 20846 V5 26 13 1
## 3 20846 V4 5 5 0
## 4 20846 V3 4 4 0
## 5 20846 V2 3 3 0
## 6 20893 V1 1 14 0
## 7 20893 V5 26 13 1
## 8 20893 V4 6 6 0
## 9 20893 V3 4 4 0
## 10 20893 V2 3 3 0
## # … with 56,865 more rows# Get count of hands with Ace as first suit, King as first or second suit - 3,640 hands
tmpAKxxxUse <- tmpCheckSuits %>%
filter((rank==14 & suit==0) | (rank==13 & suit %in% c(0, 1))) %>%
group_by(handNum) %>%
summarize(n=n()) %>%
filter(n==2)
tmpAKxxxUse## # A tibble: 3,640 × 2
## handNum n
## <int> <int>
## 1 20846 2
## 2 20893 2
## 3 20939 2
## 4 20984 2
## 5 21028 2
## 6 21071 2
## 7 21154 2
## 8 21186 2
## 9 21187 2
## 10 21188 2
## # … with 3,630 more rows# Run for all hands of AKxxx (except for AKJxx, previously run)
t <- proc.time()
resAKxxx <- calculateResults(useHandNums=tmpAKxxxUse$handNum)
proc.time()-t## user system elapsed
## 2027.05 453.35 2627.75# Save file for use later
resAK99 <- resAKJxx %>%
bind_rows(resAKxxx)
saveToRDS(resAK99, ovrWriteError=FALSE)##
## File already exists: ./RInputFiles/Coronavirus/resAK99.RDS
##
## Not replacing the existing file since ovrWrite=FALSE## NULLtmpHR <- allHandRanks %>%
filter(wType==99, tb1==14, tb2==13) %>%
semi_join(handEligible, by=c("handNum")) %>%
pull(handNum)
tmpHS <- mtxHands[tmpHR,] %>%
tibble::as_tibble(.name_repair=make.names) %>%
purrr::set_names(paste0("V", 1:5)) %>%
mutate(handNum=tmpHR) %>%
pivot_longer(-c(handNum)) %>%
mutate(rank=1 + (value-1) %% 13, rank=ifelse(rank==1, 14, rank), suit=(value-1) %/% 13) %>%
arrange(handNum, desc(rank))
# Plot of EV by hand type
resAK99 %>%
mutate(evAllIfPlay=2*pWQ+pWN-3*pLQ-3*pLN) %>%
left_join(tmpHS %>%
filter(!(rank %in% c(14, 13))) %>%
group_by(handNum) %>%
mutate(label=paste0("AK", max(rank), nth(rank, 2), min(rank)),
label=str_replace(label, "12", "Q"),
label=str_replace(label, "11", "V"),
label=str_replace(label, "10", "T"),
card3=str_sub(label, 3, 3)
) %>%
filter(row_number()==1) %>%
ungroup(),
by="handNum"
) %>%
ggplot(aes(x=factor(label))) +
coord_flip() +
labs(x=NULL,
y="Distribution",
title="EV if playing hands of type 99, ranks AKxxx",
subtitle="Fold is EV -2"
) +
geom_boxplot(aes(y=evAllIfPlay), fill="lightblue") +
geom_hline(yintercept=-2, lty=2) +
facet_wrap(~(card3 %in% c("Q", "V")), scales="free_y")
The file is explored for hands with identical win probabilities:
testSameEV <- resAK99 %>%
arrange(pWN, pTN, pLN, pLQ) %>%
group_by(rank) %>%
mutate(across(c(pWN, pTN, pLN, pLQ),
.fns=function(x) ifelse(row_number()==1, 0, x-lag(x)),
.names="{.col}_lag"
),
across(c(pWN, pTN, pLN, pLQ),
.fns=function(x) ifelse(row_number()==1, 0, lead(x)-x),
.names="{.col}_lead"
),
maxLag=pmax(abs(pWN_lag), abs(pTN_lag), abs(pLN_lag), abs(pLQ_lag)),
maxLead=pmax(abs(pWN_lead), abs(pTN_lead), abs(pLN_lead), abs(pLQ_lead))
) %>%
ungroup()
testSameEV %>%
mutate(evPlay=2*pWQ+pWN-3*pLQ-3*pLN, isSame=ifelse(maxLag<=1e-9 | maxLead <= 1e-9, "match", "unique")) %>%
ggplot(aes(x=evPlay)) +
geom_histogram(aes(fill=isSame), bins=100) +
labs(x="EV of Play", y=NULL, title="Histogram of hands that match 1+ other hands in EV")
# Hands of same rank (4380) and EV - AKQJ9
testSameEV %>%
filter(rank==4380) %>%
filter(evPlay==max(evPlay)) %>%
pull(handNum) %>%
mtxHands[.,]## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 11 26 35 51
## [2,] 1 11 26 38 48
## [3,] 1 12 26 35 50
## [4,] 1 12 26 37 48
## [5,] 1 13 22 37 51
## [6,] 1 13 22 38 50
## [7,] 1 13 24 35 51
## [8,] 1 13 24 38 48
## [9,] 1 13 25 35 50
## [10,] 1 13 25 37 48# Hands of same rank (4380) and EV - AKQJ9
testSameEV %>%
filter(rank==4380) %>%
filter(evPlay!=max(evPlay)) %>%
pull(handNum) %>%
mtxHands[.,]## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 9 12 13 24
## [2,] 1 9 11 13 25
## [3,] 1 11 12 13 22
## [4,] 1 9 11 12 26
## [5,] 1 9 12 24 26
## [6,] 1 9 13 24 25
## [7,] 1 11 12 22 26
## [8,] 1 11 13 22 25
## [9,] 1 9 11 25 26
## [10,] 1 12 13 22 24
## [11,] 1 9 13 24 38
## [12,] 1 9 13 25 37
## [13,] 1 9 12 26 37
## [14,] 1 11 13 22 38
## [15,] 1 11 13 25 35
## [16,] 1 12 13 22 37
## [17,] 1 12 13 24 35
## [18,] 1 9 11 26 38
## [19,] 1 11 12 26 35
## [20,] 1 9 24 26 38
## [21,] 1 9 25 26 37
## [22,] 1 11 22 26 38
## [23,] 1 12 22 26 37
## [24,] 1 11 25 26 35
## [25,] 1 12 24 26 35
## [26,] 1 13 22 25 37
## [27,] 1 13 22 24 38
## [28,] 1 13 24 25 35
## [29,] 1 9 26 37 51
## [30,] 1 9 26 38 50As an example, AKQJ9 with suits 2-1-1-1 have identical EV provided the matching suit cards are A/K, A/Q, or A/J.
Natural hands of type JJxxx are also explored, though suit eligibility needs to be modified:
# Eligible hands of type JJxxx
eligibleJJxxx <- allHandRanks %>%
filter(wType==11, tb1==11, tb2==11) %>%
semi_join(handSuit %>% filter(n2 <= n1, n4 <= n3, nWild==0), by=c("handNum"))
eligibleJJxxx## # A tibble: 24,090 × 9
## handNum wType tb1 tb2 tb3 tb4 tb5 chgRank rank
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 147326 11 11 11 14 13 12 1 2895
## 2 147339 11 11 11 14 13 12 0 2895
## 3 147702 11 11 11 14 13 12 0 2895
## 4 147715 11 11 11 14 13 12 0 2895
## 5 147768 11 11 11 14 13 12 0 2895
## 6 148001 11 11 11 14 13 12 0 2895
## 7 148014 11 11 11 14 13 12 0 2895
## 8 148041 11 11 11 14 13 12 0 2895
## 9 148481 11 11 11 14 13 12 0 2895
## 10 148494 11 11 11 14 13 12 0 2895
## # … with 24,080 more rows# Create tibble of hand types
mtxSmallTest <- mtxHands[eligibleJJxxx$handNum,]
tblSmallTest <- tibble::as_tibble(mtxSmallTest, .name_repair=make.names) %>%
purrr::set_names(paste0("V", 1:5)) %>%
mutate(handNum=eligibleJJxxx$handNum)
tblSmallTest## # A tibble: 24,090 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 11 12 13 24 147326
## 2 1 11 12 13 37 147339
## 3 1 11 12 24 26 147702
## 4 1 11 12 24 39 147715
## 5 1 11 12 26 37 147768
## 6 1 11 12 37 39 148001
## 7 1 11 12 37 52 148014
## 8 1 11 12 39 50 148041
## 9 1 11 13 24 25 148481
## 10 1 11 13 24 38 148494
## # … with 24,080 more rows# Get suit counts of descending cards
tmpCheckSuits <- tblSmallTest %>%
pivot_longer(-c(handNum)) %>%
mutate(rank=1 + (value-1) %% 13, rank=ifelse(rank==1, 14, rank), suit=(value-1) %/% 13) %>%
arrange(handNum, desc(rank))
tmpCheckSuits## # A tibble: 120,450 × 5
## handNum name value rank suit
## <int> <chr> <int> <dbl> <dbl>
## 1 21111 V1 1 14 0
## 2 21111 V4 11 11 0
## 3 21111 V5 24 11 1
## 4 21111 V3 4 4 0
## 5 21111 V2 3 3 0
## 6 21124 V1 1 14 0
## 7 21124 V4 11 11 0
## 8 21124 V5 37 11 2
## 9 21124 V3 4 4 0
## 10 21124 V2 3 3 0
## # … with 120,440 more rows# Get count of hands with Jack as first two suits
tmpJJxxxUse <- tmpCheckSuits %>%
filter((rank==11 & suit==0) | (rank==11 & suit %in% c(1))) %>%
group_by(handNum) %>%
summarize(n=n()) %>%
filter(n==2)
tmpJJxxxUse## # A tibble: 4,290 × 2
## handNum n
## <int> <int>
## 1 21111 2
## 2 22239 2
## 3 23320 2
## 4 24355 2
## 5 25345 2
## 6 26291 2
## 7 27194 2
## 8 28096 2
## 9 28136 2
## 10 28286 2
## # … with 4,280 more rows# Get suit counts by whether hands are used
tmpCheckSuits %>%
group_by(handNum, suit) %>%
summarize(n=n(), .groups="drop") %>%
mutate(suit=paste0("V", suit)) %>%
pivot_wider(id_cols=handNum, names_from="suit", values_from="n", values_fill=0) %>%
full_join(tmpJJxxxUse, by=c("handNum")) %>%
mutate(type=ifelse(is.na(n), "Ineligible", "Eligible")) %>%
count(type, V0, V1, V2, V3) %>%
print(n=30)## # A tibble: 24 × 6
## type V0 V1 V2 V3 n
## <chr> <int> <int> <int> <int> <int>
## 1 Eligible 1 1 2 1 495
## 2 Eligible 1 1 3 0 165
## 3 Eligible 2 1 1 1 990
## 4 Eligible 2 1 2 0 495
## 5 Eligible 2 2 1 0 990
## 6 Eligible 3 1 1 0 495
## 7 Eligible 3 2 0 0 495
## 8 Eligible 4 1 0 0 165
## 9 Ineligible 0 0 3 2 495
## 10 Ineligible 0 0 4 1 165
## 11 Ineligible 1 0 2 2 1980
## 12 Ineligible 1 0 3 1 1155
## 13 Ineligible 1 0 4 0 165
## 14 Ineligible 1 1 2 1 3960
## 15 Ineligible 1 1 3 0 990
## 16 Ineligible 2 0 2 1 1980
## 17 Ineligible 2 0 3 0 495
## 18 Ineligible 2 1 1 1 3465
## 19 Ineligible 2 1 2 0 1485
## 20 Ineligible 2 2 1 0 990
## 21 Ineligible 3 0 1 1 1155
## 22 Ineligible 3 0 2 0 495
## 23 Ineligible 3 1 1 0 660
## 24 Ineligible 4 0 1 0 165# Run for all hands of JJxxx (no wild)
t1 <- proc.time()
resJJxxx <- calculateResults(useHandNums=tmpJJxxxUse$handNum)
proc.time()-t1## user system elapsed
## 2437.81 513.11 3177.47# Save file for use later
saveToRDS(resJJxxx, ovrWriteError=FALSE)##
## File already exists: ./RInputFiles/Coronavirus/resJJxxx.RDS
##
## Not replacing the existing file since ovrWrite=FALSE## NULLHands of type JJxxx are explored for ranges of evPlay:
tmpHR <- tmpJJxxxUse %>%
pull(handNum)
tmpHS <- mtxHands[tmpHR,] %>%
tibble::as_tibble(.name_repair=make.names) %>%
purrr::set_names(paste0("V", 1:5)) %>%
mutate(handNum=tmpHR) %>%
pivot_longer(-c(handNum)) %>%
mutate(rank=1 + (value-1) %% 13, rank=ifelse(rank==1, 14, rank), suit=(value-1) %/% 13) %>%
arrange(handNum, desc(rank))
# Plot of EV by hand type
resJJxxx %>%
mutate(evAllIfPlay=2*pWQ+pWN-3*pLQ-3*pLN) %>%
left_join(tmpHS %>%
filter(!(rank %in% c(11))) %>%
group_by(handNum) %>%
mutate(label=paste0("JJ", max(rank), nth(rank, 2), min(rank)),
label=str_replace(label, "14", "A"),
label=str_replace(label, "13", "K"),
label=str_replace(label, "12", "Q"),
label=str_replace(label, "10", "T"),
card3=str_sub(label, 3, 3)
) %>%
filter(row_number()==1) %>%
ungroup(),
by="handNum"
) %>%
mutate(bucket=case_when(card3=="A" ~ "1. A", card3=="K" ~ "2. K", TRUE ~ "3. Q or lower")) %>%
ggplot(aes(x=factor(label))) +
coord_flip() +
labs(x=NULL,
y="Distribution",
title="EV of play bet for natural hands of rank JJxxx"
) +
geom_boxplot(aes(y=evPlay), fill="lightblue") +
geom_hline(yintercept=0, lty=2) +
facet_wrap(~bucket, scales="free_y")
The JJxxx with no wilds has positive evPlay provided it contains two kickers of rank A, K, or Q.
Wild hands of type 2Jxxx (pair only) are also explored:
# Eligible hands of type JJxxx
eligible2Jxxx <- allHandRanks %>%
filter(wType==11, tb1==11, tb2==11) %>%
semi_join(handSuit %>% filter(n2 <= n1, n4 <= n3, nWild==1), by=c("handNum"))
eligible2Jxxx## # A tibble: 27,560 × 9
## handNum wType tb1 tb2 tb3 tb4 tb5 chgRank rank
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 328084 11 11 11 10 9 6 1 3006
## 2 328097 11 11 11 10 9 6 0 3006
## 3 328125 11 11 11 10 9 6 0 3006
## 4 328138 11 11 11 10 9 6 0 3006
## 5 328552 11 11 11 10 9 6 0 3006
## 6 328565 11 11 11 10 9 6 0 3006
## 7 328593 11 11 11 10 9 6 0 3006
## 8 328864 11 11 11 10 9 6 0 3006
## 9 328877 11 11 11 10 9 6 0 3006
## 10 328892 11 11 11 10 9 6 0 3006
## # … with 27,550 more rows# Create tibble of hand types
mtxSmallTest <- mtxHands[eligible2Jxxx$handNum,]
tblSmallTest <- tibble::as_tibble(mtxSmallTest, .name_repair=make.names) %>%
purrr::set_names(paste0("V", 1:5)) %>%
mutate(handNum=eligible2Jxxx$handNum)
tblSmallTest## # A tibble: 27,560 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 2 6 9 10 24 328084
## 2 2 6 9 10 37 328097
## 3 2 6 9 11 23 328125
## 4 2 6 9 11 36 328138
## 5 2 6 9 23 24 328552
## 6 2 6 9 23 37 328565
## 7 2 6 9 24 36 328593
## 8 2 6 9 36 37 328864
## 9 2 6 9 36 50 328877
## 10 2 6 9 37 49 328892
## # … with 27,550 more rows# Get suit counts of descending cards
tmpCheckSuits <- tblSmallTest %>%
pivot_longer(-c(handNum)) %>%
mutate(rank=1 + (value-1) %% 13, rank=ifelse(rank==1, 14, rank), suit=(value-1) %/% 13) %>%
arrange(handNum, desc(rank))
tmpCheckSuits## # A tibble: 137,800 × 5
## handNum name value rank suit
## <int> <chr> <int> <dbl> <dbl>
## 1 270744 V5 24 11 1
## 2 270744 V4 5 5 0
## 3 270744 V3 4 4 0
## 4 270744 V2 3 3 0
## 5 270744 V1 2 2 0
## 6 270757 V5 37 11 2
## 7 270757 V4 5 5 0
## 8 270757 V3 4 4 0
## 9 270757 V2 3 3 0
## 10 270757 V1 2 2 0
## # … with 137,790 more rows# Get count of hands with Jack and deuce as first suit
tmp2JxxxUse <- tmpCheckSuits %>%
filter((rank==11 & suit==0) | (rank==2 & suit %in% c(0))) %>%
group_by(handNum) %>%
summarize(n=n()) %>%
filter(n==2)
tmp2JxxxUse## # A tibble: 1,924 × 2
## handNum n
## <int> <int>
## 1 271005 2
## 2 271006 2
## 3 271007 2
## 4 271008 2
## 5 271009 2
## 6 271010 2
## 7 271018 2
## 8 271019 2
## 9 271020 2
## 10 271021 2
## # … with 1,914 more rows# Get suit counts by whether hands are used
tmpCheckSuits %>%
group_by(handNum, suit) %>%
summarize(n=n(), .groups="drop") %>%
mutate(suit=paste0("V", suit)) %>%
pivot_wider(id_cols=handNum, names_from="suit", values_from="n", values_fill=0) %>%
full_join(tmp2JxxxUse, by=c("handNum")) %>%
mutate(type=ifelse(is.na(n), "Ineligible", "Eligible")) %>%
count(type, V0, V1, V2, V3) %>%
print(n=50)## # A tibble: 50 × 6
## type V0 V1 V2 V3 n
## <chr> <int> <int> <int> <int> <int>
## 1 Eligible 2 0 2 1 156
## 2 Eligible 2 0 3 0 52
## 3 Eligible 2 1 1 1 312
## 4 Eligible 2 1 2 0 156
## 5 Eligible 3 0 1 1 312
## 6 Eligible 3 0 2 0 156
## 7 Eligible 3 1 1 0 312
## 8 Eligible 3 2 0 0 156
## 9 Eligible 4 0 1 0 156
## 10 Eligible 4 1 0 0 156
## 11 Ineligible 0 0 2 2 312
## 12 Ineligible 0 0 2 3 312
## 13 Ineligible 0 0 3 1 208
## 14 Ineligible 0 0 3 2 520
## 15 Ineligible 0 0 4 1 208
## 16 Ineligible 0 1 2 2 312
## 17 Ineligible 0 1 3 1 208
## 18 Ineligible 1 0 2 1 624
## 19 Ineligible 1 0 2 2 936
## 20 Ineligible 1 0 3 0 208
## 21 Ineligible 1 0 3 1 1040
## 22 Ineligible 1 0 4 0 208
## 23 Ineligible 1 1 1 1 1248
## 24 Ineligible 1 1 1 2 1248
## 25 Ineligible 1 1 2 0 624
## 26 Ineligible 1 1 2 1 2496
## 27 Ineligible 1 1 3 0 832
## 28 Ineligible 1 2 1 1 1248
## 29 Ineligible 1 2 2 0 624
## 30 Ineligible 2 0 1 1 624
## 31 Ineligible 2 0 1 2 624
## 32 Ineligible 2 0 2 0 312
## 33 Ineligible 2 0 2 1 1404
## 34 Ineligible 2 0 3 0 468
## 35 Ineligible 2 1 1 0 624
## 36 Ineligible 2 1 1 1 2184
## 37 Ineligible 2 1 2 0 1404
## 38 Ineligible 2 2 0 0 312
## 39 Ineligible 2 2 0 1 312
## 40 Ineligible 2 2 1 0 936
## 41 Ineligible 2 3 0 0 312
## 42 Ineligible 3 0 1 0 208
## 43 Ineligible 3 0 1 1 520
## 44 Ineligible 3 0 2 0 364
## 45 Ineligible 3 1 0 0 208
## 46 Ineligible 3 1 0 1 208
## 47 Ineligible 3 1 1 0 728
## 48 Ineligible 3 2 0 0 364
## 49 Ineligible 4 0 1 0 52
## 50 Ineligible 4 1 0 0 52# Run for all hands of 2Jxxx (one wild, pair only)
t1 <- proc.time()
res2Jxxx <- calculateResults(useHandNums=tmp2JxxxUse$handNum)
proc.time()-t1## user system elapsed
## 1055.92 236.65 1355.34# Save file for use later
saveToRDS(res2Jxxx, ovrWriteError=FALSE)##
## File already exists: ./RInputFiles/Coronavirus/res2Jxxx.RDS
##
## Not replacing the existing file since ovrWrite=FALSE## NULLHands of type 2Jxxx are explored for ranges of evPlay:
tmpHR <- tmp2JxxxUse %>%
pull(handNum)
tmpHS <- mtxHands[tmpHR,] %>%
tibble::as_tibble(.name_repair=make.names) %>%
purrr::set_names(paste0("V", 1:5)) %>%
mutate(handNum=tmpHR) %>%
pivot_longer(-c(handNum)) %>%
mutate(rank=1 + (value-1) %% 13, rank=ifelse(rank==1, 14, rank), suit=(value-1) %/% 13) %>%
arrange(handNum, desc(rank))
# Plot of EV by hand type
res2Jxxx %>%
mutate(evAllIfPlay=2*pWQ+pWN-3*pLQ-3*pLN) %>%
left_join(tmpHS %>%
filter(!(rank %in% c(11, 2))) %>%
group_by(handNum) %>%
mutate(label=paste0("WJ", max(rank), nth(rank, 2), min(rank)),
label=str_replace(label, "14", "A"),
label=str_replace(label, "13", "K"),
label=str_replace(label, "12", "Q"),
label=str_replace(label, "10", "T"),
card3=str_sub(label, 3, 3)
) %>%
filter(row_number()==1) %>%
ungroup(),
by="handNum"
) %>%
mutate(bucket=case_when(card3=="A" ~ "1. A", card3=="K" ~ "2. K", TRUE ~ "3. Q or lower")) %>%
ggplot(aes(x=factor(label))) +
coord_flip() +
labs(x=NULL,
y="evPlay",
title="EV of play bet for wild pairs of rank WJxxx"
) +
geom_boxplot(aes(y=evPlay), fill="lightblue") +
geom_hline(yintercept=0, lty=2) +
facet_wrap(~bucket, scales="free_y")
All wild pairs JJ have positive evPlay. Wild hands of type 2Txxx (pair only) are also explored:
# Eligible hands of type TTxxx
eligible2Txxx <- allHandRanks %>%
filter(wType==11, tb1==10, tb2==10) %>%
semi_join(handSuit %>% filter(n2 <= n1, n4 <= n3, nWild==1), by=c("handNum"))
eligible2Txxx## # A tibble: 16,430 × 9
## handNum wType tb1 tb2 tb3 tb4 tb5 chgRank rank
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 310879 11 10 10 9 8 5 1 3192
## 2 310892 11 10 10 9 8 5 0 3192
## 3 310921 11 10 10 9 8 5 0 3192
## 4 310934 11 10 10 9 8 5 0 3192
## 5 311360 11 10 10 9 8 5 0 3192
## 6 311373 11 10 10 9 8 5 0 3192
## 7 311402 11 10 10 9 8 5 0 3192
## 8 311685 11 10 10 9 8 5 0 3192
## 9 311698 11 10 10 9 8 5 0 3192
## 10 311714 11 10 10 9 8 5 0 3192
## # … with 16,420 more rows# Create tibble of hand types
mtxSmallTest <- mtxHands[eligible2Txxx$handNum,]
tblSmallTest <- tibble::as_tibble(mtxSmallTest, .name_repair=make.names) %>%
purrr::set_names(paste0("V", 1:5)) %>%
mutate(handNum=eligible2Txxx$handNum)
tblSmallTest## # A tibble: 16,430 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 2 5 8 9 23 310879
## 2 2 5 8 9 36 310892
## 3 2 5 8 10 22 310921
## 4 2 5 8 10 35 310934
## 5 2 5 8 22 23 311360
## 6 2 5 8 22 36 311373
## 7 2 5 8 23 35 311402
## 8 2 5 8 35 36 311685
## 9 2 5 8 35 49 311698
## 10 2 5 8 36 48 311714
## # … with 16,420 more rows# Get suit counts of descending cards
tmpCheckSuits <- tblSmallTest %>%
pivot_longer(-c(handNum)) %>%
mutate(rank=1 + (value-1) %% 13, rank=ifelse(rank==1, 14, rank), suit=(value-1) %/% 13) %>%
arrange(handNum, desc(rank))
tmpCheckSuits## # A tibble: 82,150 × 5
## handNum name value rank suit
## <int> <chr> <int> <dbl> <dbl>
## 1 270743 V5 23 10 1
## 2 270743 V4 5 5 0
## 3 270743 V3 4 4 0
## 4 270743 V2 3 3 0
## 5 270743 V1 2 2 0
## 6 270756 V5 36 10 2
## 7 270756 V4 5 5 0
## 8 270756 V3 4 4 0
## 9 270756 V2 3 3 0
## 10 270756 V1 2 2 0
## # … with 82,140 more rows# Get count of hands with Ten and deuce as first suit
tmp2TxxxUse <- tmpCheckSuits %>%
filter((rank==10 & suit==0) | (rank==2 & suit %in% c(0))) %>%
group_by(handNum) %>%
summarize(n=n()) %>%
filter(n==2)
tmp2TxxxUse## # A tibble: 1,147 × 2
## handNum n
## <int> <int>
## 1 270963 2
## 2 270964 2
## 3 270965 2
## 4 270966 2
## 5 270967 2
## 6 270976 2
## 7 270977 2
## 8 270978 2
## 9 270979 2
## 10 270980 2
## # … with 1,137 more rows# Get suit counts by whether hands are used
tmpCheckSuits %>%
group_by(handNum, suit) %>%
summarize(n=n(), .groups="drop") %>%
mutate(suit=paste0("V", suit)) %>%
pivot_wider(id_cols=handNum, names_from="suit", values_from="n", values_fill=0) %>%
full_join(tmp2TxxxUse, by=c("handNum")) %>%
mutate(type=ifelse(is.na(n), "Ineligible", "Eligible")) %>%
count(type, V0, V1, V2, V3) %>%
print(n=50)## # A tibble: 50 × 6
## type V0 V1 V2 V3 n
## <chr> <int> <int> <int> <int> <int>
## 1 Eligible 2 0 2 1 93
## 2 Eligible 2 0 3 0 31
## 3 Eligible 2 1 1 1 186
## 4 Eligible 2 1 2 0 93
## 5 Eligible 3 0 1 1 186
## 6 Eligible 3 0 2 0 93
## 7 Eligible 3 1 1 0 186
## 8 Eligible 3 2 0 0 93
## 9 Eligible 4 0 1 0 93
## 10 Eligible 4 1 0 0 93
## 11 Ineligible 0 0 2 2 186
## 12 Ineligible 0 0 2 3 186
## 13 Ineligible 0 0 3 1 124
## 14 Ineligible 0 0 3 2 310
## 15 Ineligible 0 0 4 1 124
## 16 Ineligible 0 1 2 2 186
## 17 Ineligible 0 1 3 1 124
## 18 Ineligible 1 0 2 1 372
## 19 Ineligible 1 0 2 2 558
## 20 Ineligible 1 0 3 0 124
## 21 Ineligible 1 0 3 1 620
## 22 Ineligible 1 0 4 0 124
## 23 Ineligible 1 1 1 1 744
## 24 Ineligible 1 1 1 2 744
## 25 Ineligible 1 1 2 0 372
## 26 Ineligible 1 1 2 1 1488
## 27 Ineligible 1 1 3 0 496
## 28 Ineligible 1 2 1 1 744
## 29 Ineligible 1 2 2 0 372
## 30 Ineligible 2 0 1 1 372
## 31 Ineligible 2 0 1 2 372
## 32 Ineligible 2 0 2 0 186
## 33 Ineligible 2 0 2 1 837
## 34 Ineligible 2 0 3 0 279
## 35 Ineligible 2 1 1 0 372
## 36 Ineligible 2 1 1 1 1302
## 37 Ineligible 2 1 2 0 837
## 38 Ineligible 2 2 0 0 186
## 39 Ineligible 2 2 0 1 186
## 40 Ineligible 2 2 1 0 558
## 41 Ineligible 2 3 0 0 186
## 42 Ineligible 3 0 1 0 124
## 43 Ineligible 3 0 1 1 310
## 44 Ineligible 3 0 2 0 217
## 45 Ineligible 3 1 0 0 124
## 46 Ineligible 3 1 0 1 124
## 47 Ineligible 3 1 1 0 434
## 48 Ineligible 3 2 0 0 217
## 49 Ineligible 4 0 1 0 31
## 50 Ineligible 4 1 0 0 31# Run for all hands of 2Jxxx (one wild, pair only)
t1 <- proc.time()
res2Txxx <- calculateResults(useHandNums=tmp2TxxxUse$handNum)
proc.time()-t1## user system elapsed
## 709.86 162.35 923.19# Save file for use later
saveToRDS(res2Txxx, ovrWriteError=FALSE)##
## File already exists: ./RInputFiles/Coronavirus/res2Txxx.RDS
##
## Not replacing the existing file since ovrWrite=FALSE## NULLHands of type 2Jxxx are explored for ranges of evPlay:
tmpHR <- tmp2TxxxUse %>%
pull(handNum)
tmpHS <- mtxHands[tmpHR,] %>%
tibble::as_tibble(.name_repair=make.names) %>%
purrr::set_names(paste0("V", 1:5)) %>%
mutate(handNum=tmpHR) %>%
pivot_longer(-c(handNum)) %>%
mutate(rank=1 + (value-1) %% 13, rank=ifelse(rank==1, 14, rank), suit=(value-1) %/% 13) %>%
arrange(handNum, desc(rank))
# Plot of EV by hand type
res2Txxx %>%
mutate(evAllDouble=3*pWQ+2*pWN-4*pLQ-4*pLN,
evAllSingle=2*pWQ+pWN-3*pLQ-3*pLN
) %>%
left_join(tmpHS %>%
filter(!(rank %in% c(10, 2))) %>%
group_by(handNum) %>%
mutate(label=paste0("WT", max(rank), nth(rank, 2), min(rank)),
label=str_replace(label, "14", "A"),
label=str_replace(label, "13", "K"),
label=str_replace(label, "12", "Q"),
label=str_replace(label, "10", "T"),
card3=str_sub(label, 3, 3)
) %>%
filter(row_number()==1) %>%
ungroup(),
by="handNum"
) %>%
select(handNum, label, evPlay, evAllSingle, evAllDouble) %>%
pivot_longer(cols=-c(handNum, label)) %>%
ggplot(aes(x=factor(label))) +
coord_flip() +
labs(x=NULL,
y=NULL,
title="EV for wild pairs of rank WTxxx"
) +
geom_boxplot(aes(y=value), fill="lightblue") +
geom_hline(aes(yintercept=ifelse(name=="evPlay", 0, -1)), lty=2) +
facet_wrap(~c("evPlay"="1. EV of play bet",
"evAllSingle"="2. EV of all main bets (single play)",
"evAllDouble"="3. EV of all main bets (double play)"
)[name],
scales="free_x"
)
All wild pairs TT have negative evPlay.
Natural hands of type QQxxx are also explored:
# Eligible hands of type JJxxx
eligibleQQxxx <- allHandRanks %>%
filter(wType==11, tb1==12, tb2==12) %>%
semi_join(handSuit %>% filter(n2 <= n1, n4 <= n3, nWild==0), by=c("handNum"))
eligibleQQxxx## # A tibble: 24,090 × 9
## handNum wType tb1 tb2 tb3 tb4 tb5 chgRank rank
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 147327 11 12 12 14 13 11 1 2730
## 2 147340 11 12 12 14 13 11 0 2730
## 3 147730 11 12 12 14 13 11 0 2730
## 4 147743 11 12 12 14 13 11 0 2730
## 5 147769 11 12 12 14 13 11 0 2730
## 6 148016 11 12 12 14 13 11 0 2730
## 7 148029 11 12 12 14 13 11 0 2730
## 8 148042 11 12 12 14 13 11 0 2730
## 9 148522 11 12 12 14 13 11 0 2730
## 10 148808 11 12 12 14 13 11 0 2730
## # … with 24,080 more rows# Create tibble of hand types
mtxSmallTest <- mtxHands[eligibleQQxxx$handNum,]
tblSmallTest <- tibble::as_tibble(mtxSmallTest, .name_repair=make.names) %>%
purrr::set_names(paste0("V", 1:5)) %>%
mutate(handNum=eligibleQQxxx$handNum)
tblSmallTest## # A tibble: 24,090 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 11 12 13 25 147327
## 2 1 11 12 13 38 147340
## 3 1 11 12 25 26 147730
## 4 1 11 12 25 39 147743
## 5 1 11 12 26 38 147769
## 6 1 11 12 38 39 148016
## 7 1 11 12 38 52 148029
## 8 1 11 12 39 51 148042
## 9 1 11 13 25 38 148522
## 10 1 11 13 38 51 148808
## # … with 24,080 more rows# Get suit counts of descending cards
tmpCheckSuits <- tblSmallTest %>%
pivot_longer(-c(handNum)) %>%
mutate(rank=1 + (value-1) %% 13, rank=ifelse(rank==1, 14, rank), suit=(value-1) %/% 13) %>%
arrange(handNum, desc(rank))
tmpCheckSuits## # A tibble: 120,450 × 5
## handNum name value rank suit
## <int> <chr> <int> <dbl> <dbl>
## 1 21153 V1 1 14 0
## 2 21153 V4 12 12 0
## 3 21153 V5 25 12 1
## 4 21153 V3 4 4 0
## 5 21153 V2 3 3 0
## 6 21166 V1 1 14 0
## 7 21166 V4 12 12 0
## 8 21166 V5 38 12 2
## 9 21166 V3 4 4 0
## 10 21166 V2 3 3 0
## # … with 120,440 more rows# Get count of hands with Jack as first two suits
tmpQQxxxUse <- tmpCheckSuits %>%
filter((rank==12 & suit==0) | (rank==12 & suit %in% c(1))) %>%
group_by(handNum) %>%
summarize(n=n()) %>%
filter(n==2)
tmpQQxxxUse## # A tibble: 4,290 × 2
## handNum n
## <int> <int>
## 1 21153 2
## 2 22281 2
## 3 23362 2
## 4 24397 2
## 5 25387 2
## 6 26333 2
## 7 27236 2
## 8 28097 2
## 9 28957 2
## 10 29107 2
## # … with 4,280 more rows# Get suit counts by whether hands are used
tmpCheckSuits %>%
group_by(handNum, suit) %>%
summarize(n=n(), .groups="drop") %>%
mutate(suit=paste0("V", suit)) %>%
pivot_wider(id_cols=handNum, names_from="suit", values_from="n", values_fill=0) %>%
full_join(tmpQQxxxUse, by=c("handNum")) %>%
mutate(type=ifelse(is.na(n), "Ineligible", "Eligible")) %>%
count(type, V0, V1, V2, V3) %>%
print(n=30)## # A tibble: 24 × 6
## type V0 V1 V2 V3 n
## <chr> <int> <int> <int> <int> <int>
## 1 Eligible 1 1 2 1 495
## 2 Eligible 1 1 3 0 165
## 3 Eligible 2 1 1 1 990
## 4 Eligible 2 1 2 0 495
## 5 Eligible 2 2 1 0 990
## 6 Eligible 3 1 1 0 495
## 7 Eligible 3 2 0 0 495
## 8 Eligible 4 1 0 0 165
## 9 Ineligible 0 0 3 2 495
## 10 Ineligible 0 0 4 1 165
## 11 Ineligible 1 0 2 2 1980
## 12 Ineligible 1 0 3 1 1155
## 13 Ineligible 1 0 4 0 165
## 14 Ineligible 1 1 2 1 3960
## 15 Ineligible 1 1 3 0 990
## 16 Ineligible 2 0 2 1 1980
## 17 Ineligible 2 0 3 0 495
## 18 Ineligible 2 1 1 1 3465
## 19 Ineligible 2 1 2 0 1485
## 20 Ineligible 2 2 1 0 990
## 21 Ineligible 3 0 1 1 1155
## 22 Ineligible 3 0 2 0 495
## 23 Ineligible 3 1 1 0 660
## 24 Ineligible 4 0 1 0 165# Run for all hands of JJxxx (no wild)
t1 <- proc.time()
resQQxxx <- calculateResults(useHandNums=tmpQQxxxUse$handNum)
proc.time()-t1## user system elapsed
## 2157.81 437.55 2666.48# Save file for use later
saveToRDS(resQQxxx, ovrWriteError=FALSE)##
## File already exists: ./RInputFiles/Coronavirus/resQQxxx.RDS
##
## Not replacing the existing file since ovrWrite=FALSE## NULLHands of type QQxxx are explored for ranges of evPlay:
tmpHR <- tmpQQxxxUse %>%
pull(handNum)
tmpHS <- mtxHands[tmpHR,] %>%
tibble::as_tibble(.name_repair=make.names) %>%
purrr::set_names(paste0("V", 1:5)) %>%
mutate(handNum=tmpHR) %>%
pivot_longer(-c(handNum)) %>%
mutate(rank=1 + (value-1) %% 13, rank=ifelse(rank==1, 14, rank), suit=(value-1) %/% 13) %>%
arrange(handNum, desc(rank))
# Plot of EV by hand type
resQQxxx %>%
mutate(evAllDouble=3*pWQ+2*pWN-4*pLQ-4*pLN,
evAllSingle=2*pWQ+pWN-3*pLQ-3*pLN
) %>%
left_join(tmpHS %>%
filter(!(rank %in% c(12, 2))) %>%
group_by(handNum) %>%
mutate(label=paste0("QQ", max(rank), nth(rank, 2), min(rank)),
label=str_replace(label, "11", "J"),
label=str_replace(label, "13", "K"),
label=str_replace(label, "14", "A"),
label=str_replace(label, "10", "T"),
card3=str_sub(label, 3, 3)
) %>%
filter(row_number()==1) %>%
ungroup(),
by="handNum"
) %>%
select(handNum, label, evPlay, card3) %>%
pivot_longer(cols=-c(handNum, label, card3)) %>%
ggplot(aes(x=factor(label))) +
coord_flip() +
labs(x=NULL,
y=NULL,
title="EV for natural pairs of rank QQxxx"
) +
geom_boxplot(aes(y=value), fill="lightblue") +
geom_hline(aes(yintercept=ifelse(name=="evPlay", 0, -1)), lty=2) +
facet_wrap(~c("A"="1. A",
"K"="2. K/J", "J"="2. K/J",
"T"="3. 5-T", "9"="3. 5-T", "8"="3. 5-T", "7"="3. 5-T", "6"="3. 5-T", "5"="3. 5-T"
)[card3],
scales="free_y"
)
All natural pairs of rank QQxxx have positive evPlay. There are step-increases as xxx includes one or two cards of rank that can outpair QQ (A or K)
A subset of hands is explored that can be analyzed:
- Wilds, if any, are in ascending order (e.g., 2-15 is OK, but just 53
is not)
- Number of non-wild cards by suit is non-ascending (Spades >=
Hearts >= Diamonds >= Clubs)
- If two suits have the same number of cards, the “rank is non-ascending (Spades >= Hearts >= Diamonds >= Clubs)
Code for the first two rules includes:
# Eligible wild combinations
all5Wild <- purrr::reduce(.x=cardInHand[c(2, 15, 28, 41, 53)], .f=intersect)
first4Wild <- purrr::reduce(.x=cardInHand[c(2, 15, 28, 41)], .f=intersect) %>%
setdiff(purrr::reduce(.x=cardInHand[c(53)], .f=union))
first3Wild <- purrr::reduce(.x=cardInHand[c(2, 15, 28)], .f=intersect) %>%
setdiff(purrr::reduce(.x=cardInHand[c(41, 53)], .f=union))
first2Wild <- purrr::reduce(.x=cardInHand[c(2, 15)], .f=intersect) %>%
setdiff(purrr::reduce(.x=cardInHand[c(28, 41, 53)], .f=union))
first1Wild <- purrr::reduce(.x=cardInHand[c(2)], .f=intersect) %>%
setdiff(purrr::reduce(.x=cardInHand[c(15, 28, 41, 53)], .f=union))
has0Wild <- (1:nrow(mtxHands)) %>%
setdiff(purrr::reduce(.x=cardInHand[c(2, 15, 28, 41, 53)], .f=union))
wildEligible <- tibble::tibble(handNum=c(all5Wild, first4Wild, first3Wild, first2Wild, first1Wild, has0Wild)) %>%
arrange(handNum)
sortedHandRanks %>%
mutate(wildEligible=ifelse(handNum %in% wildEligible$handNum, "Eligible", "Not")) %>%
count(nWild, wildEligible) %>%
arrange(desc(nWild), wildEligible) %>%
pivot_wider(id_cols=c("nWild"), names_from="wildEligible", values_from="n", values_fill=0) %>%
bind_rows(colSums(.)) %>%
mutate(nWild=case_when(nWild<=5~as.character(nWild), TRUE~"Total"), pctOK=Eligible/(Eligible+Not))## # A tibble: 7 × 4
## nWild Eligible Not pctOK
## <chr> <dbl> <dbl> <dbl>
## 1 5 1 0 1
## 2 4 48 192 0.2
## 3 3 1128 10152 0.1
## 4 2 17296 155664 0.1
## 5 1 194580 778320 0.2
## 6 0 1712304 0 1
## 7 Total 1925357 944328 0.671# Count by suit
t <- proc.time()
uaSpades <- tibble::tibble(handNum=purrr::reduce(.x=cardInHand[c(1, 3:13)], .f=union_all))
uaHearts <- tibble::tibble(handNum=purrr::reduce(.x=cardInHand[c(14, 16:26)], .f=union_all))
uaDiamonds <- tibble::tibble(handNum=purrr::reduce(.x=cardInHand[c(27, 29:39)], .f=union_all))
uaClubs <- tibble::tibble(handNum=purrr::reduce(.x=cardInHand[c(40, 42:52)], .f=union_all))
uaAll <- bind_rows(uaSpades, uaHearts, uaDiamonds, uaClubs, .id="suit") %>%
mutate(suit=c("1"="Spades", "2"="Hearts", "3"="Diamonds", "4"="Clubs")[suit])
nPerSuit <- uaAll %>%
mutate(n=1) %>%
pivot_wider(id_cols="handNum", names_from="suit", values_from="n", values_fn=sum, values_fill=0)
proc.time()-t## user system elapsed
## 47.29 2.69 55.42# Analysis of eligibility
suitCountEligible <- nPerSuit %>%
mutate(isOK=ifelse((Spades >= Hearts) & (Hearts >= Diamonds) & (Diamonds >= Clubs), "yes", "no"))
suitCountIneligible <- suitCountEligible %>% filter(isOK=="no") %>% pull(handNum)
sortedHandRanks %>%
mutate(wildEligible=ifelse(handNum %in% wildEligible$handNum, "Eligible", "Not"),
suitCountEligible=ifelse(handNum %in% suitCountIneligible, "Not", "Eligible")
) %>%
count(nWild, wildEligible, suitCountEligible) %>%
mutate(nEligible=ifelse(wildEligible=="Eligible" & suitCountEligible=="Eligible", n, 0))## # A tibble: 19 × 5
## nWild wildEligible suitCountEligible n nEligible
## <dbl> <chr> <chr> <int> <dbl>
## 1 0 Eligible Eligible 219252 219252
## 2 0 Eligible Not 1493052 0
## 3 1 Eligible Eligible 37731 37731
## 4 1 Eligible Not 156849 0
## 5 1 Not Eligible 150924 0
## 6 1 Not Not 627396 0
## 7 2 Eligible Eligible 2740 2740
## 8 2 Eligible Not 14556 0
## 9 2 Not Eligible 24660 0
## 10 2 Not Not 131004 0
## 11 3 Eligible Eligible 210 210
## 12 3 Eligible Not 918 0
## 13 3 Not Eligible 1890 0
## 14 3 Not Not 8262 0
## 15 4 Eligible Eligible 12 12
## 16 4 Eligible Not 36 0
## 17 4 Not Eligible 48 0
## 18 4 Not Not 144 0
## 19 5 Eligible Eligible 1 1# Masks for suits
t <- proc.time()
maskSpade <- mtxHands %in% c(1, 3:13) %>% matrix(nrow=nrow(mtxHands), ncol=5, byrow=FALSE)
maskHeart <- mtxHands %in% (13+c(1, 3:13)) %>% matrix(nrow=nrow(mtxHands), ncol=5, byrow=FALSE)
maskDiamond <- mtxHands %in% (26+c(1, 3:13)) %>% matrix(nrow=nrow(mtxHands), ncol=5, byrow=FALSE)
maskClub <- mtxHands %in% (39+c(1, 3:13)) %>% matrix(nrow=nrow(mtxHands), ncol=5, byrow=FALSE)
suitCountCheck <- tibble::tibble(handNum=1:nrow(mtxHands),
nSpade=rowSums(maskSpade),
nHeart=rowSums(maskHeart),
nDiamond=rowSums(maskDiamond),
nClub=rowSums(maskClub)
)
proc.time()-t## user system elapsed
## 2.17 0.78 3.14# Confirm same results
nPerSuit %>%
right_join(select(sortedHandRanks, handNum), by="handNum") %>%
mutate(across(-c(handNum), .fns=function(x) ifelse(is.na(x), 0, x))) %>%
arrange(handNum) %>%
purrr::set_names(names(suitCountCheck)) %>%
identical(x=., y=suitCountCheck)## [1] TRUEThe suit combinations of eligible hands are explored:
suitRankCountTable <- sortedHandRanks %>%
select(handNum, nWild) %>%
left_join(nPerSuit, by=c("handNum")) %>%
mutate(across(-c(handNum, nWild), .fns=function(x) ifelse(is.na(x), 0, x)),
wildEligible=ifelse(handNum %in% wildEligible$handNum, "Eligible", "Not"),
suitEligible=ifelse((Spades>=Hearts) & (Hearts>=Diamonds) & (Diamonds>=Clubs), "yes", "no")
) %>%
count(nWild, wildEligible, suitEligible, Spades, Hearts, Diamonds, Clubs) %>%
filter(wildEligible=="Eligible", suitEligible=="yes") %>%
arrange(-nWild, -Spades, -Hearts) %>%
select(nWild, wildEligible, suitEligible, everything())
suitRankCountTable## # A tibble: 18 × 8
## nWild wildEligible suitEligible Spades Hearts Diamonds Clubs n
## <dbl> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <int>
## 1 5 Eligible yes 0 0 0 0 1
## 2 4 Eligible yes 1 0 0 0 12
## 3 3 Eligible yes 2 0 0 0 66
## 4 3 Eligible yes 1 1 0 0 144
## 5 2 Eligible yes 3 0 0 0 220
## 6 2 Eligible yes 2 1 0 0 792
## 7 2 Eligible yes 1 1 1 0 1728
## 8 1 Eligible yes 4 0 0 0 495
## 9 1 Eligible yes 3 1 0 0 2640
## 10 1 Eligible yes 2 2 0 0 4356
## 11 1 Eligible yes 2 1 1 0 9504
## 12 1 Eligible yes 1 1 1 1 20736
## 13 0 Eligible yes 5 0 0 0 792
## 14 0 Eligible yes 4 1 0 0 5940
## 15 0 Eligible yes 3 2 0 0 14520
## 16 0 Eligible yes 3 1 1 0 31680
## 17 0 Eligible yes 2 2 1 0 52272
## 18 0 Eligible yes 2 1 1 1 114048# Duplicated combinations of 1-1-1-1 and 2-2
tmpSingleRank <- expand.grid(spades=3:14, hearts=3:14, diamonds=3:14, clubs=3:14) %>%
tibble::as_tibble()
tmpSingleRank## # A tibble: 20,736 × 4
## spades hearts diamonds clubs
## <int> <int> <int> <int>
## 1 3 3 3 3
## 2 4 3 3 3
## 3 5 3 3 3
## 4 6 3 3 3
## 5 7 3 3 3
## 6 8 3 3 3
## 7 9 3 3 3
## 8 10 3 3 3
## 9 11 3 3 3
## 10 12 3 3 3
## # … with 20,726 more rows# Resolving ties of type 1-1 (assume spades and hearts, suits are invariant)
elig11 <- tmpSingleRank %>%
select(spades, hearts) %>%
unique() %>%
mutate(eligible=ifelse(spades>=hearts, "yes", "no"))
elig11 %>% count(eligible) %>% mutate(pct=n/sum(n))## # A tibble: 2 × 3
## eligible n pct
## <chr> <int> <dbl>
## 1 no 66 0.458
## 2 yes 78 0.542# Resolving ties of type 2-2 (assume spades and hearts, suits are invariant)
elig22 <- tmpSingleRank %>%
rename(spade2=diamonds, heart2=clubs) %>%
filter(spades>spade2, hearts>heart2) %>%
unique() %>%
mutate(eligible=ifelse((spades>hearts) | (spades==hearts & spade2>=heart2), "yes", "no"))
elig22 %>% count(eligible) %>% mutate(pct=n/sum(n))## # A tibble: 2 × 3
## eligible n pct
## <chr> <int> <dbl>
## 1 no 2145 0.492
## 2 yes 2211 0.508# Resolving ties of type 1-1-1 (assume spades and hearts and diamonds, suits are invariant)
elig111 <- tmpSingleRank %>%
select(spades, hearts, diamonds) %>%
unique() %>%
mutate(eligible=ifelse((spades>=hearts) & (hearts>=diamonds), "yes", "no"))
elig111 %>% count(eligible) %>% mutate(pct=n/sum(n))## # A tibble: 2 × 3
## eligible n pct
## <chr> <int> <dbl>
## 1 no 1364 0.789
## 2 yes 364 0.211# Resolving ties of type 1-1-1-1 (all suits)
elig1111 <- tmpSingleRank %>%
select(spades, hearts, diamonds, clubs) %>%
unique() %>%
mutate(eligible=ifelse((spades>=hearts) & (hearts>=diamonds) & (diamonds>=clubs), "yes", "no"))
elig1111 %>% count(eligible) %>% mutate(pct=n/sum(n))## # A tibble: 2 × 3
## eligible n pct
## <chr> <int> <dbl>
## 1 no 19371 0.934
## 2 yes 1365 0.0658# Full eligibility data
eligibleMap <- sapply(list(elig11, elig111, elig1111, elig22), FUN=function(x) mean(x$eligible=="yes")) %>%
purrr::set_names(c("1-1", "1-1-1", "1-1-1-1", "2-2"))
eligibleMap <- c(eligibleMap, "none"=1)
eligibleMap## 1-1 1-1-1 1-1-1-1 2-2 none
## 0.54166667 0.21064815 0.06582755 0.50757576 1.00000000# Expected hands after de-duplications
suitRankCountDedup <- suitRankCountTable %>%
mutate(dupType=case_when((Spades==1 & Hearts==1 & Diamonds==0)~"1-1",
(Spades==1 & Hearts==1 & Diamonds==1 & Clubs==0)~"1-1-1",
(Spades==2 & Hearts==2)~"2-2",
(Spades>1 & Hearts==1 & Diamonds==1 & Clubs==0)~"1-1",
(Spades==1 & Hearts==1 & Diamonds==1 & Clubs==1)~"1-1-1-1",
(Spades>1 & Hearts==1 & Diamonds==1 & Clubs==1)~"1-1-1",
TRUE~"none"
),
dedupRatio=eligibleMap[dupType],
uniqueN=n*dedupRatio
)
suitRankCountDedup## # A tibble: 18 × 11
## nWild wildEligible suitE…¹ Spades Hearts Diamo…² Clubs n dupType dedup…³
## <dbl> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <int> <chr> <dbl>
## 1 5 Eligible yes 0 0 0 0 1 none 1
## 2 4 Eligible yes 1 0 0 0 12 none 1
## 3 3 Eligible yes 2 0 0 0 66 none 1
## 4 3 Eligible yes 1 1 0 0 144 1-1 0.542
## 5 2 Eligible yes 3 0 0 0 220 none 1
## 6 2 Eligible yes 2 1 0 0 792 none 1
## 7 2 Eligible yes 1 1 1 0 1728 1-1-1 0.211
## 8 1 Eligible yes 4 0 0 0 495 none 1
## 9 1 Eligible yes 3 1 0 0 2640 none 1
## 10 1 Eligible yes 2 2 0 0 4356 2-2 0.508
## 11 1 Eligible yes 2 1 1 0 9504 1-1 0.542
## 12 1 Eligible yes 1 1 1 1 20736 1-1-1-1 0.0658
## 13 0 Eligible yes 5 0 0 0 792 none 1
## 14 0 Eligible yes 4 1 0 0 5940 none 1
## 15 0 Eligible yes 3 2 0 0 14520 none 1
## 16 0 Eligible yes 3 1 1 0 31680 1-1 0.542
## 17 0 Eligible yes 2 2 1 0 52272 2-2 0.508
## 18 0 Eligible yes 2 1 1 1 114048 1-1-1 0.211
## # … with 1 more variable: uniqueN <dbl>, and abbreviated variable names
## # ¹suitEligible, ²Diamonds, ³dedupRatiosuitRankCountDedup %>%
group_by(nWild) %>%
summarize(across(c(n, uniqueN), .fns=sum)) %>%
arrange(desc(nWild)) %>%
column_to_rownames("nWild") %>%
mutate(pctUniqueN=round(uniqueN/sum(uniqueN),4)) %>%
bind_rows(colSums(.))## n uniqueN pctUniqueN
## 5 1 1 0.0000
## 4 12 12 0.0001
## 3 210 144 0.0014
## 2 2740 1376 0.0134
## 1 37731 11859 0.1159
## 0 219252 88968 0.8692
## ...7 259946 102360 1.0000After de-duplication, there are 102,360 unique hands that can be dealt in the game (assuming that the rank of wilds does not matter and that the highest-powered suit in order is spades, hearts, diamonds, clubs). Most of these are hands that do not contain a wild
The subset of non-duplicated hands with no wilds are extracted:
# Create a tibble of hands
tblHands <- tibble::as_tibble(mtxHands) %>%
mutate(handNum=1:nrow(.))## Warning: The `x` argument of `as_tibble.matrix()` must have unique column names if
## `.name_repair` is omitted as of tibble 2.0.0.
## ℹ Using compatibility `.name_repair`.tblHands## # A tibble: 2,869,685 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 2 3 4 5 1
## 2 1 2 3 4 6 2
## 3 1 2 3 4 7 3
## 4 1 2 3 4 8 4
## 5 1 2 3 4 9 5
## 6 1 2 3 4 10 6
## 7 1 2 3 4 11 7
## 8 1 2 3 4 12 8
## 9 1 2 3 4 13 9
## 10 1 2 3 4 14 10
## # … with 2,869,675 more rows# Get the relevant last 3 cards for 2-1-1-1
tmpLast3 <- elig111 %>%
mutate(across(c(spades, hearts, diamonds), .fns=function(x) ifelse(x==14, 1, x))) %>%
filter(eligible=="yes") %>%
rename(V5=diamonds, V4=hearts, V3=spades) %>%
mutate(V3=V3+13, V4=V4+26, V5=V5+39)
# Get the set of 2-1-1-1 hands
hn2111 <- tblHands %>%
semi_join(select(tmpLast3, V3, V4, V5), by=c("V3", "V4", "V5")) %>%
filter(V1 %in% c(1, 3:13), V2 %in% c(1, 3:13))
hn2111## # A tibble: 24,024 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 3 14 27 40 30948
## 2 1 3 14 27 42 30950
## 3 1 3 14 27 43 30951
## 4 1 3 14 27 44 30952
## 5 1 3 14 27 45 30953
## 6 1 3 14 27 46 30954
## 7 1 3 14 27 47 30955
## 8 1 3 14 27 48 30956
## 9 1 3 14 27 49 30957
## 10 1 3 14 27 50 30958
## # … with 24,014 more rows# Check that hand numbers are all eligible
nPerSuit %>%
semi_join(hn2111, by="handNum") %>%
mutate(wildOK=ifelse(handNum %in% wildEligible$handNum, "yes", "no")) %>%
count(wildOK, Spades, Hearts, Diamonds, Clubs)## # A tibble: 1 × 6
## wildOK Spades Hearts Diamonds Clubs n
## <chr> <dbl> <dbl> <dbl> <dbl> <int>
## 1 yes 2 1 1 1 24024# Get the relevant first 4 cards for 2-2-1
tmpFirst4 <- elig22 %>%
mutate(across(c(spades, spade2, hearts, heart2), .fns=function(x) ifelse(x==14, 1, x))) %>%
filter(eligible=="yes") %>%
mutate(V1=pmin(spades, spade2),
V2=pmax(spades, spade2),
V3=13+pmin(hearts, heart2),
V4=13+pmax(hearts, heart2)
)
# Get the set of 2-2-1 hands
hn221 <- tblHands %>%
semi_join(select(tmpFirst4, V1, V2, V3, V4), by=c("V1", "V2", "V3", "V4")) %>%
filter(V5 %in% c(27, 29:39))
hn221## # A tibble: 26,532 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 3 14 16 27 30594
## 2 1 3 14 16 29 30596
## 3 1 3 14 16 30 30597
## 4 1 3 14 16 31 30598
## 5 1 3 14 16 32 30599
## 6 1 3 14 16 33 30600
## 7 1 3 14 16 34 30601
## 8 1 3 14 16 35 30602
## 9 1 3 14 16 36 30603
## 10 1 3 14 16 37 30604
## # … with 26,522 more rows# Check that hand numbers are all eligible
nPerSuit %>%
semi_join(hn221, by="handNum") %>%
mutate(wildOK=ifelse(handNum %in% wildEligible$handNum, "yes", "no")) %>%
count(wildOK, Spades, Hearts, Diamonds, Clubs)## # A tibble: 1 × 6
## wildOK Spades Hearts Diamonds Clubs n
## <chr> <dbl> <dbl> <dbl> <dbl> <int>
## 1 yes 2 2 1 0 26532# Get the relevant last 2 cards for 3-1-1
tmpLast2 <- elig11 %>%
mutate(across(c(spades, hearts), .fns=function(x) ifelse(x==14, 1, x))) %>%
filter(eligible=="yes") %>%
mutate(V4=spades+13, V5=hearts+26)
# Get the set of 3-1-1 hands
hn311 <- tblHands %>%
semi_join(select(tmpLast2, V4, V5), by=c("V4", "V5")) %>%
filter(V1 %in% c(1, 3:13), V2 %in% c(1, 3:13), V3 %in% c(1, 3:13))
hn311## # A tibble: 17,160 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 3 4 14 27 21234
## 2 1 3 4 14 29 21236
## 3 1 3 4 14 30 21237
## 4 1 3 4 14 31 21238
## 5 1 3 4 14 32 21239
## 6 1 3 4 14 33 21240
## 7 1 3 4 14 34 21241
## 8 1 3 4 14 35 21242
## 9 1 3 4 14 36 21243
## 10 1 3 4 14 37 21244
## # … with 17,150 more rows# Check that hand numbers are all eligible
nPerSuit %>%
semi_join(hn311, by="handNum") %>%
mutate(wildOK=ifelse(handNum %in% wildEligible$handNum, "yes", "no")) %>%
count(wildOK, Spades, Hearts, Diamonds, Clubs)## # A tibble: 1 × 6
## wildOK Spades Hearts Diamonds Clubs n
## <chr> <dbl> <dbl> <dbl> <dbl> <int>
## 1 yes 3 1 1 0 17160# Get the set of 3-2-0 and 4-1-0 and 5-0-0 hands
tmp3Plus <- nPerSuit %>%
filter((Spades==5) | (Spades==4 & Hearts==1) | (Spades==3 & Hearts==2))
hn3Plus <- tblHands %>%
semi_join(select(tmp3Plus, handNum), by=c("handNum"))
hn3Plus## # A tibble: 21,252 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 3 4 5 6 20826
## 2 1 3 4 5 7 20827
## 3 1 3 4 5 8 20828
## 4 1 3 4 5 9 20829
## 5 1 3 4 5 10 20830
## 6 1 3 4 5 11 20831
## 7 1 3 4 5 12 20832
## 8 1 3 4 5 13 20833
## 9 1 3 4 5 14 20834
## 10 1 3 4 5 16 20836
## # … with 21,242 more rows# Check that hand numbers are all eligible
nPerSuit %>%
semi_join(hn3Plus, by="handNum") %>%
mutate(wildOK=ifelse(handNum %in% wildEligible$handNum, "yes", "no")) %>%
count(wildOK, Spades, Hearts, Diamonds, Clubs)## # A tibble: 3 × 6
## wildOK Spades Hearts Diamonds Clubs n
## <chr> <dbl> <dbl> <dbl> <dbl> <int>
## 1 yes 3 2 0 0 14520
## 2 yes 4 1 0 0 5940
## 3 yes 5 0 0 0 792# Integrate all relevant hand numbers
hn0Wild <- bind_rows(hn2111, hn221, hn311, hn3Plus) %>%
left_join(select(sortedHandRanks, handNum, wType, qual, nWild), by=c("handNum")) %>%
left_join(nPerSuit, by=c("handNum"))
hn0Wild## # A tibble: 88,968 × 13
## V1 V2 V3 V4 V5 handNum wType qual nWild Spades Hearts Diamo…¹
## <int> <int> <int> <int> <int> <int> <dbl> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 1 3 14 27 40 30948 5 Q 0 2 1 1
## 2 1 3 14 27 42 30950 6 Q 0 2 1 1
## 3 1 3 14 27 43 30951 9 Q 0 2 1 1
## 4 1 3 14 27 44 30952 9 Q 0 2 1 1
## 5 1 3 14 27 45 30953 9 Q 0 2 1 1
## 6 1 3 14 27 46 30954 9 Q 0 2 1 1
## 7 1 3 14 27 47 30955 9 Q 0 2 1 1
## 8 1 3 14 27 48 30956 9 Q 0 2 1 1
## 9 1 3 14 27 49 30957 9 Q 0 2 1 1
## 10 1 3 14 27 50 30958 9 Q 0 2 1 1
## # … with 88,958 more rows, 1 more variable: Clubs <dbl>, and abbreviated
## # variable name ¹Diamonds# Summarize hand types and suits
hn0Wild %>% count(nWild, Spades, Hearts, Diamonds, Clubs)## # A tibble: 6 × 6
## nWild Spades Hearts Diamonds Clubs n
## <dbl> <dbl> <dbl> <dbl> <dbl> <int>
## 1 0 2 1 1 1 24024
## 2 0 2 2 1 0 26532
## 3 0 3 1 1 0 17160
## 4 0 3 2 0 0 14520
## 5 0 4 1 0 0 5940
## 6 0 5 0 0 0 792hn0Wild %>% count(nWild, qual, wType)## # A tibble: 10 × 4
## nWild qual wType n
## <dbl> <chr> <dbl> <int>
## 1 0 N 99 39200
## 2 0 Q 2 1
## 3 0 Q 4 7
## 4 0 Q 5 132
## 5 0 Q 6 264
## 6 0 Q 7 784
## 7 0 Q 8 400
## 8 0 Q 9 3300
## 9 0 Q 10 5280
## 10 0 Q 11 39600hn0Wild %>% count(nWild, qual, wType, Spades, Hearts, Diamonds, Clubs) %>% print(n=30)## # A tibble: 28 × 8
## nWild qual wType Spades Hearts Diamonds Clubs n
## <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <int>
## 1 0 N 99 2 1 1 1 7840
## 2 0 N 99 2 2 1 0 11760
## 3 0 N 99 3 1 1 0 7840
## 4 0 N 99 3 2 0 0 7840
## 5 0 N 99 4 1 0 0 3920
## 6 0 Q 2 5 0 0 0 1
## 7 0 Q 4 5 0 0 0 7
## 8 0 Q 5 2 1 1 1 132
## 9 0 Q 6 2 1 1 1 132
## 10 0 Q 6 2 2 1 0 132
## 11 0 Q 7 5 0 0 0 784
## 12 0 Q 8 2 1 1 1 80
## 13 0 Q 8 2 2 1 0 120
## 14 0 Q 8 3 1 1 0 80
## 15 0 Q 8 3 2 0 0 80
## 16 0 Q 8 4 1 0 0 40
## 17 0 Q 9 2 1 1 1 1980
## 18 0 Q 9 2 2 1 0 660
## 19 0 Q 9 3 1 1 0 660
## 20 0 Q 10 2 1 1 1 1980
## 21 0 Q 10 2 2 1 0 1980
## 22 0 Q 10 3 1 1 0 660
## 23 0 Q 10 3 2 0 0 660
## 24 0 Q 11 2 1 1 1 11880
## 25 0 Q 11 2 2 1 0 11880
## 26 0 Q 11 3 1 1 0 7920
## 27 0 Q 11 3 2 0 0 5940
## 28 0 Q 11 4 1 0 0 1980The file is split in to components for running hands:
# Zero pairs (around 10k hands per sequence)
seq2a <- hn0Wild %>% filter(wType==99, V1==1)
seq2b <- hn0Wild %>% filter(wType==99, V1 %in% c(3, 4))
seq2c <- hn0Wild %>% filter(wType==99, V1 %in% c(5, 6, 7))
seq2d <- hn0Wild %>% filter(wType==99, V1 %in% c(8, 9, 10, 11, 12))
# One pair (around 10k hands per sequence)
seq2e <- hn0Wild %>% filter(wType==11, V1==1)
seq2f <- hn0Wild %>% filter(wType==11, V1 %in% c(3, 4))
seq2g <- hn0Wild %>% filter(wType==11, V1 %in% c(5, 6, 7))
seq2h <- hn0Wild %>% filter(wType==11, V1 %in% c(8, 9, 10, 11, 12))
# Two pair or better
seq2j <- hn0Wild %>% filter(!(wType %in% c(11, 99)))
# Check that data are the same
bind_rows(seq2a, seq2b, seq2c, seq2d, seq2e, seq2f, seq2g, seq2h, seq2j) %>%
arrange(V1, V2, V3, V4, V5) %>%
identical(arrange(hn0Wild, V1, V2, V3, V4, V5))## [1] TRUEA function is written to run a hand number sequence only if the sequence is not already saved:
# Function to check if file exists and run if so
runHandSequence <- function(handNums,
rdsName,
skipIfExists=TRUE,
saveFile=TRUE,
ovrWrite=FALSE,
returnFile=!isTRUE(saveFile) | (!isTRUE(skipIfExists) & !isTRUE(ovrWrite))
) {
# FUNCTION ARGUMENTS:
# handNums: sequence of hand numbers to evaluate
# rdsName: name of the RDS file (if exists or to be saved - no directory, no .RDS extension)
# skipIfExists: boolean, if TRUE, check whether the file is already saved, and skip running if so
# saveFile: boolean, should the file be saved after running
# ovrWrite: boolean, should the previous file be overwritten?
# returnFile: boolean, should the file be returned after creation?
# Manage the file existence and decision to run or not run
keyLoc <- paste0(formals(readFromRDS)$dir, rdsName, formals(readFromRDS)$addSuffix)
fileExists <- file.exists(keyLoc)
if(isTRUE(skipIfExists) & isTRUE(fileExists)) {
cat("\nFile", keyLoc, "already exists, exiting without running or overwriting\n")
return(NULL)
}
# Run the process and report on the time
t1 <- proc.time()
df <- calculateResults(useHandNums=handNums)
print(proc.time()-t1)
# Save the file if requested (overwriting the existing file)
if(isTRUE(saveFile)) {
# If file is to be overwritten, delete it
if(isTRUE(ovrWrite) & isTRUE(fileExists)) {
cat("\nRemoving existing file", keyLoc, "so new file can be written\n")
Sys.chmod(keyLoc, mode="0777", use_umask=FALSE)
file.remove(keyLoc)
}
# Write the file
saveToRDS(obj=df, file=paste0(rdsName, ".RDS"), ovrWriteError=FALSE)
}
# Return the file if requested
if(isTRUE(returnFile)) return(df)
}# Run for all non-duplicate hands of type 99 (no pair, no wild), Ace high
runHandSequence(handNums=seq2a$handNum, rdsName="ICGA_v001_seq2a", skipIfExists=TRUE, saveFile=TRUE)## user system elapsed
## 5189.31 1183.49 6599.25# Run for all non-duplicate hands of type 99 (no pair, no wild), sequence b
runHandSequence(handNums=seq2b$handNum, rdsName="ICGA_v001_seq2b", skipIfExists=TRUE, saveFile=TRUE)## user system elapsed
## 5935.16 1326.14 7715.20# Run for all non-duplicate hands of type 99 (no pair, no wild), sequence c
runHandSequence(handNums=seq2c$handNum, rdsName="ICGA_v001_seq2c", skipIfExists=TRUE, saveFile=TRUE)## user system elapsed
## 5464.62 1211.41 6932.75# Run for all non-duplicate hands of type 99 (no pair, no wild), sequence d
runHandSequence(handNums=seq2d$handNum, rdsName="ICGA_v001_seq2d", skipIfExists=TRUE, saveFile=TRUE)## user system elapsed
## 3230.28 703.88 4098.36# Run for all non-duplicate hands of type 11 (one pair) with no wild, sequence e
runHandSequence(handNums=seq2e$handNum, rdsName="ICGA_v001_seq2e", skipIfExists=TRUE, saveFile=TRUE)## user system elapsed
## 4895.08 1070.31 6257.23# Run for all non-duplicate hands of type 11 (one pair) with no wild, sequence f
runHandSequence(handNums=seq2f$handNum, rdsName="ICGA_v001_seq2f", skipIfExists=TRUE, saveFile=TRUE)## user system elapsed
## 5475.38 1233.81 6993.06# Run for all non-duplicate hands of type 11 (one pair) with no wild, sequence g
runHandSequence(handNums=seq2g$handNum, rdsName="ICGA_v001_seq2g", skipIfExists=TRUE, saveFile=TRUE)## user system elapsed
## 5613.12 1253.73 7100.91# Run for all non-duplicate hands of type 11 (one pair) with no wild, sequence h
runHandSequence(handNums=seq2h$handNum, rdsName="ICGA_v001_seq2h", skipIfExists=TRUE, saveFile=TRUE)## user system elapsed
## 4030.45 859.87 5224.47# Run for all non-duplicate hands of type 10 (two pair) or better with no wild, sequence j
runHandSequence(handNums=seq2j$handNum, rdsName="ICGA_v001_seq2j", skipIfExists=TRUE, saveFile=TRUE)## user system elapsed
## 5189.89 1139.44 6611.94The subset of non-duplicated hands with one wild are extracted:
# Get the relevant last 4 cards for 1-1-1-1
tmpLast4 <- elig1111 %>%
mutate(across(c(spades, hearts, diamonds, clubs), .fns=function(x) ifelse(x==14, 1, x))) %>%
filter(eligible=="yes") %>%
rename(V5=clubs, V4=diamonds, V3=hearts) %>%
mutate(V1=ifelse(spades==1, spades, 2), V2=ifelse(spades==1, 2, spades), V3=V3+13, V4=V4+26, V5=V5+39)
# Get the set of 1-1-1-1 hands
hn1111 <- tblHands %>%
semi_join(select(tmpLast4, V1, V2, V3, V4, V5), by=c("V1", "V2", "V3", "V4", "V5"))
hn1111## # A tibble: 1,365 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 2 14 27 40 11348
## 2 1 2 14 27 42 11350
## 3 1 2 14 27 43 11351
## 4 1 2 14 27 44 11352
## 5 1 2 14 27 45 11353
## 6 1 2 14 27 46 11354
## 7 1 2 14 27 47 11355
## 8 1 2 14 27 48 11356
## 9 1 2 14 27 49 11357
## 10 1 2 14 27 50 11358
## # … with 1,355 more rows# Check that hand numbers are all eligible
nPerSuit %>%
semi_join(hn1111, by="handNum") %>%
mutate(wildOK=ifelse(handNum %in% wildEligible$handNum, "yes", "no")) %>%
count(wildOK, Spades, Hearts, Diamonds, Clubs)## # A tibble: 1 × 6
## wildOK Spades Hearts Diamonds Clubs n
## <chr> <dbl> <dbl> <dbl> <dbl> <int>
## 1 yes 1 1 1 1 1365# Get the relevant first 4 cards for 2-2-0
tmpWild22 <- elig22 %>%
mutate(across(c(spades, spade2, hearts, heart2), .fns=function(x) ifelse(x==14, 1, x))) %>%
filter(eligible=="yes") %>%
mutate(V1=pmin(spades, 2, spade2),
V2=ifelse(V1==1, 2, pmin(spades, spade2)),
V3=pmax(spades, 2, spade2),
V4=13+pmin(hearts, heart2),
V5=13+pmax(hearts, heart2)
)
# Get the set of 2-2-0 hands
hn22 <- tblHands %>%
semi_join(select(tmpWild22, V1, V2, V3, V4, V5), by=c("V1", "V2", "V3", "V4", "V5"))
hn22## # A tibble: 2,211 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 2 3 14 16 447
## 2 1 2 3 16 17 523
## 3 1 2 3 16 18 524
## 4 1 2 3 16 19 525
## 5 1 2 3 16 20 526
## 6 1 2 3 16 21 527
## 7 1 2 3 16 22 528
## 8 1 2 3 16 23 529
## 9 1 2 3 16 24 530
## 10 1 2 3 16 25 531
## # … with 2,201 more rows# Check that hand numbers are all eligible
nPerSuit %>%
semi_join(hn22, by="handNum") %>%
mutate(wildOK=ifelse(handNum %in% wildEligible$handNum, "yes", "no")) %>%
count(wildOK, Spades, Hearts, Diamonds, Clubs)## # A tibble: 1 × 6
## wildOK Spades Hearts Diamonds Clubs n
## <chr> <dbl> <dbl> <dbl> <dbl> <int>
## 1 yes 2 2 0 0 2211# Get the relevant last 2 cards for 2-1-1
tmpWild11 <- elig11 %>%
mutate(across(c(spades, hearts), .fns=function(x) ifelse(x==14, 1, x))) %>%
filter(eligible=="yes") %>%
mutate(V4=spades+13, V5=hearts+26)
# Get the set of 2-1-1 hands
hn211 <- tblHands %>%
semi_join(select(tmpWild11, V4, V5), by=c("V4", "V5")) %>%
filter(V1 %in% c(1:13), V2 %in% c(1:13), V3 %in% c(1:13), V1==2 | V2==2)
hn211## # A tibble: 5,148 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 2 3 14 27 458
## 2 1 2 3 14 29 460
## 3 1 2 3 14 30 461
## 4 1 2 3 14 31 462
## 5 1 2 3 14 32 463
## 6 1 2 3 14 33 464
## 7 1 2 3 14 34 465
## 8 1 2 3 14 35 466
## 9 1 2 3 14 36 467
## 10 1 2 3 14 37 468
## # … with 5,138 more rows# Check that hand numbers are all eligible
nPerSuit %>%
semi_join(hn211, by="handNum") %>%
mutate(wildOK=ifelse(handNum %in% wildEligible$handNum, "yes", "no")) %>%
count(wildOK, Spades, Hearts, Diamonds, Clubs)## # A tibble: 1 × 6
## wildOK Spades Hearts Diamonds Clubs n
## <chr> <dbl> <dbl> <dbl> <dbl> <int>
## 1 yes 2 1 1 0 5148# Get the set of 3-1-0 and 4-0-0 hands
tmpWild34 <- nPerSuit %>%
filter((Spades==3 & Hearts==1 & Diamonds==0 & Clubs==0) | (Spades==4 & Hearts==0 & Diamonds==0 & Clubs==0))
hnWild34 <- tblHands %>%
semi_join(select(tmpWild34, handNum), by=c("handNum")) %>%
filter(V1==2 | V2==2)
hnWild34## # A tibble: 3,135 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 2 3 4 5 1
## 2 1 2 3 4 6 2
## 3 1 2 3 4 7 3
## 4 1 2 3 4 8 4
## 5 1 2 3 4 9 5
## 6 1 2 3 4 10 6
## 7 1 2 3 4 11 7
## 8 1 2 3 4 12 8
## 9 1 2 3 4 13 9
## 10 1 2 3 4 14 10
## # … with 3,125 more rows# Check that hand numbers are all eligible
nPerSuit %>%
semi_join(hnWild34, by="handNum") %>%
mutate(wildOK=ifelse(handNum %in% wildEligible$handNum, "yes", "no")) %>%
count(wildOK, Spades, Hearts, Diamonds, Clubs)## # A tibble: 2 × 6
## wildOK Spades Hearts Diamonds Clubs n
## <chr> <dbl> <dbl> <dbl> <dbl> <int>
## 1 yes 3 1 0 0 2640
## 2 yes 4 0 0 0 495# Integrate all relevant hand numbers
hn1Wild <- bind_rows(hn1111, hn22, hn211, hnWild34) %>%
left_join(select(sortedHandRanks, handNum, wType, qual, nWild), by=c("handNum")) %>%
left_join(nPerSuit, by=c("handNum"))
hn1Wild## # A tibble: 11,859 × 13
## V1 V2 V3 V4 V5 handNum wType qual nWild Spades Hearts Diamo…¹
## <int> <int> <int> <int> <int> <int> <dbl> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 1 2 14 27 40 11348 3 Q 1 1 1 1
## 2 1 2 14 27 42 11350 5 Q 1 1 1 1
## 3 1 2 14 27 43 11351 5 Q 1 1 1 1
## 4 1 2 14 27 44 11352 5 Q 1 1 1 1
## 5 1 2 14 27 45 11353 5 Q 1 1 1 1
## 6 1 2 14 27 46 11354 5 Q 1 1 1 1
## 7 1 2 14 27 47 11355 5 Q 1 1 1 1
## 8 1 2 14 27 48 11356 5 Q 1 1 1 1
## 9 1 2 14 27 49 11357 5 Q 1 1 1 1
## 10 1 2 14 27 50 11358 5 Q 1 1 1 1
## # … with 11,849 more rows, 1 more variable: Clubs <dbl>, and abbreviated
## # variable name ¹Diamonds# Summarize hand types and suits
hn1Wild %>% count(nWild, Spades, Hearts, Diamonds, Clubs)## # A tibble: 5 × 6
## nWild Spades Hearts Diamonds Clubs n
## <dbl> <dbl> <dbl> <dbl> <dbl> <int>
## 1 1 1 1 1 1 1365
## 2 1 2 1 1 0 5148
## 3 1 2 2 0 0 2211
## 4 1 3 1 0 0 2640
## 5 1 4 0 0 0 495hn1Wild %>% count(nWild, qual, wType)## # A tibble: 9 × 4
## nWild qual wType n
## <dbl> <chr> <dbl> <int>
## 1 1 Q 2 5
## 2 1 Q 3 12
## 3 1 Q 4 29
## 4 1 Q 5 264
## 5 1 Q 6 198
## 6 1 Q 7 461
## 7 1 Q 8 476
## 8 1 Q 9 3960
## 9 1 Q 11 6454hn1Wild %>% count(nWild, qual, wType, Spades, Hearts, Diamonds, Clubs) %>% print(n=30)## # A tibble: 21 × 8
## nWild qual wType Spades Hearts Diamonds Clubs n
## <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <int>
## 1 1 Q 2 4 0 0 0 5
## 2 1 Q 3 1 1 1 1 12
## 3 1 Q 4 4 0 0 0 29
## 4 1 Q 5 1 1 1 1 132
## 5 1 Q 5 2 1 1 0 132
## 6 1 Q 6 1 1 1 1 66
## 7 1 Q 6 2 1 1 0 66
## 8 1 Q 6 2 2 0 0 66
## 9 1 Q 7 4 0 0 0 461
## 10 1 Q 8 1 1 1 1 34
## 11 1 Q 8 2 1 1 0 204
## 12 1 Q 8 2 2 0 0 102
## 13 1 Q 8 3 1 0 0 136
## 14 1 Q 9 1 1 1 1 660
## 15 1 Q 9 2 1 1 0 1980
## 16 1 Q 9 2 2 0 0 660
## 17 1 Q 9 3 1 0 0 660
## 18 1 Q 11 1 1 1 1 461
## 19 1 Q 11 2 1 1 0 2766
## 20 1 Q 11 2 2 0 0 1383
## 21 1 Q 11 3 1 0 0 1844# Run for all non-duplicate hands of type 10 (two pair) or better with no wild, sequence j
runHandSequence(handNums=hn1Wild$handNum, rdsName="ICGA_v001_1wild", skipIfExists=TRUE, saveFile=TRUE)## user system elapsed
## 6143.86 1416.25 7963.70The subset of non-duplicated hands with two wild are extracted:
# Get the relevant last 3 cards for 1-1-1
tmpLast3 <- elig111 %>%
mutate(across(c(spades, hearts, diamonds), .fns=function(x) ifelse(x==14, 1, x))) %>%
filter(eligible=="yes") %>%
rename(V5=diamonds) %>%
mutate(V1=ifelse(spades==1, spades, 2),
V2=ifelse(spades==1, 2, spades),
V3=ifelse(hearts==1, 13+hearts, 15),
V4=ifelse(hearts==1, 15, 13+hearts),
V5=V5+26
)
# Get the set of 1-1-1 hands
hn111 <- tblHands %>%
semi_join(select(tmpLast3, V1, V2, V3, V4, V5), by=c("V1", "V2", "V3", "V4", "V5"))
hn111## # A tibble: 364 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 2 14 15 27 10957
## 2 1 2 14 15 29 10959
## 3 1 2 14 15 30 10960
## 4 1 2 14 15 31 10961
## 5 1 2 14 15 32 10962
## 6 1 2 14 15 33 10963
## 7 1 2 14 15 34 10964
## 8 1 2 14 15 35 10965
## 9 1 2 14 15 36 10966
## 10 1 2 14 15 37 10967
## # … with 354 more rows# Check that hand numbers are all eligible
nPerSuit %>%
semi_join(hn111, by="handNum") %>%
mutate(wildOK=ifelse(handNum %in% wildEligible$handNum, "yes", "no")) %>%
count(wildOK, Spades, Hearts, Diamonds, Clubs)## # A tibble: 1 × 6
## wildOK Spades Hearts Diamonds Clubs n
## <chr> <dbl> <dbl> <dbl> <dbl> <int>
## 1 yes 1 1 1 0 364# Get the set of 2-1-0 and 3-0-0 hands
tmpWild23 <- nPerSuit %>%
filter((Spades==2 & Hearts==1 & Diamonds==0 & Clubs==0) | (Spades==3 & Hearts==0 & Diamonds==0 & Clubs==0))
hnWild23 <- tblHands %>%
semi_join(select(tmpWild23, handNum), by=c("handNum")) %>%
filter((V1==2 | V2==2) & (V3==15 | V4==15 | V5==15))
hnWild23## # A tibble: 1,012 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 2 3 4 15 11
## 2 1 2 3 5 15 59
## 3 1 2 3 6 15 106
## 4 1 2 3 7 15 152
## 5 1 2 3 8 15 197
## 6 1 2 3 9 15 241
## 7 1 2 3 10 15 284
## 8 1 2 3 11 15 326
## 9 1 2 3 12 15 367
## 10 1 2 3 13 15 407
## # … with 1,002 more rows# Check that hand numbers are all eligible
nPerSuit %>%
semi_join(hnWild23, by="handNum") %>%
mutate(wildOK=ifelse(handNum %in% wildEligible$handNum, "yes", "no")) %>%
count(wildOK, Spades, Hearts, Diamonds, Clubs)## # A tibble: 2 × 6
## wildOK Spades Hearts Diamonds Clubs n
## <chr> <dbl> <dbl> <dbl> <dbl> <int>
## 1 yes 2 1 0 0 792
## 2 yes 3 0 0 0 220# Integrate all relevant hand numbers
hn2Wild <- bind_rows(hn111, hnWild23) %>%
left_join(select(sortedHandRanks, handNum, wType, qual, nWild), by=c("handNum")) %>%
left_join(nPerSuit, by=c("handNum"))
hn2Wild## # A tibble: 1,376 × 13
## V1 V2 V3 V4 V5 handNum wType qual nWild Spades Hearts Diamo…¹
## <int> <int> <int> <int> <int> <int> <dbl> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 1 2 14 15 27 10957 3 Q 2 1 1 1
## 2 1 2 14 15 29 10959 5 Q 2 1 1 1
## 3 1 2 14 15 30 10960 5 Q 2 1 1 1
## 4 1 2 14 15 31 10961 5 Q 2 1 1 1
## 5 1 2 14 15 32 10962 5 Q 2 1 1 1
## 6 1 2 14 15 33 10963 5 Q 2 1 1 1
## 7 1 2 14 15 34 10964 5 Q 2 1 1 1
## 8 1 2 14 15 35 10965 5 Q 2 1 1 1
## 9 1 2 14 15 36 10966 5 Q 2 1 1 1
## 10 1 2 14 15 37 10967 5 Q 2 1 1 1
## # … with 1,366 more rows, 1 more variable: Clubs <dbl>, and abbreviated
## # variable name ¹Diamonds# Summarize hand types and suits
hn2Wild %>% count(nWild, Spades, Hearts, Diamonds, Clubs)## # A tibble: 3 × 6
## nWild Spades Hearts Diamonds Clubs n
## <dbl> <dbl> <dbl> <dbl> <dbl> <int>
## 1 2 1 1 1 0 364
## 2 2 2 1 0 0 792
## 3 2 3 0 0 0 220hn2Wild %>% count(nWild, qual, wType)## # A tibble: 7 × 4
## nWild qual wType n
## <dbl> <chr> <dbl> <int>
## 1 2 Q 2 10
## 2 2 Q 3 12
## 3 2 Q 4 45
## 4 2 Q 5 264
## 5 2 Q 7 165
## 6 2 Q 8 220
## 7 2 Q 9 660hn2Wild %>% count(nWild, qual, wType, Spades, Hearts, Diamonds, Clubs) %>% print(n=30)## # A tibble: 10 × 8
## nWild qual wType Spades Hearts Diamonds Clubs n
## <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <int>
## 1 2 Q 2 3 0 0 0 10
## 2 2 Q 3 1 1 1 0 12
## 3 2 Q 4 3 0 0 0 45
## 4 2 Q 5 1 1 1 0 132
## 5 2 Q 5 2 1 0 0 132
## 6 2 Q 7 3 0 0 0 165
## 7 2 Q 8 1 1 1 0 55
## 8 2 Q 8 2 1 0 0 165
## 9 2 Q 9 1 1 1 0 165
## 10 2 Q 9 2 1 0 0 495# Run for all non-duplicate hands of type 10 (two pair) or better with no wild, sequence j
runHandSequence(handNums=hn2Wild$handNum, rdsName="ICGA_v001_2wild", skipIfExists=TRUE, saveFile=TRUE)## user system elapsed
## 708.88 156.41 903.55The subset of non-duplicated hands with three-plus wild are extracted:
# Get the relevant middle 2 cards for 1-1
tmpMid2 <- elig11 %>%
mutate(across(c(spades, hearts), .fns=function(x) ifelse(x==14, 1, x))) %>%
filter(eligible=="yes") %>%
mutate(V1=ifelse(spades==1, spades, 2),
V2=ifelse(spades==1, 2, spades),
V3=ifelse(hearts==1, 13+hearts, 15),
V4=ifelse(hearts==1, 15, 13+hearts),
V5=28
)
# Get the set of 1-1 hands
hn11 <- tblHands %>%
semi_join(select(tmpMid2, V1, V2, V3, V4, V5), by=c("V1", "V2", "V3", "V4", "V5"))
hn11## # A tibble: 78 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 2 14 15 28 10958
## 2 1 2 15 16 28 11698
## 3 1 2 15 17 28 11734
## 4 1 2 15 18 28 11769
## 5 1 2 15 19 28 11803
## 6 1 2 15 20 28 11836
## 7 1 2 15 21 28 11868
## 8 1 2 15 22 28 11899
## 9 1 2 15 23 28 11929
## 10 1 2 15 24 28 11958
## # … with 68 more rows# Check that hand numbers are all eligible
nPerSuit %>%
semi_join(hn11, by="handNum") %>%
mutate(wildOK=ifelse(handNum %in% wildEligible$handNum, "yes", "no")) %>%
count(wildOK, Spades, Hearts, Diamonds, Clubs)## # A tibble: 1 × 6
## wildOK Spades Hearts Diamonds Clubs n
## <chr> <dbl> <dbl> <dbl> <dbl> <int>
## 1 yes 1 1 0 0 78# Get the set of 2-0-0-0
tmpWild2 <- nPerSuit %>%
filter((Spades==2 & Hearts==0 & Diamonds==0 & Clubs==0))
hnWild2 <- tblHands %>%
semi_join(select(tmpWild2, handNum), by=c("handNum")) %>%
filter((V1==2 | V2==2) & V4==15 & V5==28)
hnWild2## # A tibble: 66 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 2 3 15 28 497
## 2 1 2 4 15 28 1673
## 3 1 2 5 15 28 2801
## 4 1 2 6 15 28 3882
## 5 1 2 7 15 28 4917
## 6 1 2 8 15 28 5907
## 7 1 2 9 15 28 6853
## 8 1 2 10 15 28 7756
## 9 1 2 11 15 28 8617
## 10 1 2 12 15 28 9437
## # … with 56 more rows# Check that hand numbers are all eligible
nPerSuit %>%
semi_join(hnWild2, by="handNum") %>%
mutate(wildOK=ifelse(handNum %in% wildEligible$handNum, "yes", "no")) %>%
count(wildOK, Spades, Hearts, Diamonds, Clubs)## # A tibble: 1 × 6
## wildOK Spades Hearts Diamonds Clubs n
## <chr> <dbl> <dbl> <dbl> <dbl> <int>
## 1 yes 2 0 0 0 66# Get the set of 1-0-0-0 and 0-0-0-0 hands (hand number 444444, not in nPerSuit)
tmpWild45 <- nPerSuit %>%
filter((Spades==1 & Hearts==0 & Diamonds==0 & Clubs==0)) %>%
bind_rows(tibble::tibble(handNum=444444, Spades=0, Hearts=0, Diamonds=0, Clubs=0))
hnWild45 <- tblHands %>%
semi_join(select(tmpWild45, handNum), by=c("handNum")) %>%
filter((V1==2 | V2==2) & (V2==15 | V3==15) & (V3==28 | V4==28) & (V4==41 | V5==41))
hnWild45## # A tibble: 13 × 6
## V1 V2 V3 V4 V5 handNum
## <int> <int> <int> <int> <int> <int>
## 1 1 2 15 28 41 12077
## 2 2 3 15 28 41 281577
## 3 2 4 15 28 41 300001
## 4 2 5 15 28 41 317297
## 5 2 6 15 28 41 333512
## 6 2 7 15 28 41 348692
## 7 2 8 15 28 41 362882
## 8 2 9 15 28 41 376126
## 9 2 10 15 28 41 388467
## 10 2 11 15 28 41 399947
## 11 2 12 15 28 41 410607
## 12 2 13 15 28 41 420487
## 13 2 15 28 41 53 444444# Check that hand numbers are all eligible
nPerSuit %>%
bind_rows(tibble::tibble(handNum=444444, Spades=0, Hearts=0, Diamonds=0, Clubs=0)) %>%
semi_join(hnWild45, by="handNum") %>%
mutate(wildOK=ifelse(handNum %in% wildEligible$handNum, "yes", "no")) %>%
count(wildOK, Spades, Hearts, Diamonds, Clubs)## # A tibble: 2 × 6
## wildOK Spades Hearts Diamonds Clubs n
## <chr> <dbl> <dbl> <dbl> <dbl> <int>
## 1 yes 0 0 0 0 1
## 2 yes 1 0 0 0 12# Integrate all relevant hand numbers
hn3PlusWild <- bind_rows(hn11, hnWild2, hnWild45) %>%
left_join(select(sortedHandRanks, handNum, wType, qual, nWild), by=c("handNum")) %>%
left_join(nPerSuit, by=c("handNum"))
hn3PlusWild## # A tibble: 157 × 13
## V1 V2 V3 V4 V5 handNum wType qual nWild Spades Hearts Diamo…¹
## <int> <int> <int> <int> <int> <int> <dbl> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 1 2 14 15 28 10958 3 Q 3 1 1 0
## 2 1 2 15 16 28 11698 5 Q 3 1 1 0
## 3 1 2 15 17 28 11734 5 Q 3 1 1 0
## 4 1 2 15 18 28 11769 5 Q 3 1 1 0
## 5 1 2 15 19 28 11803 5 Q 3 1 1 0
## 6 1 2 15 20 28 11836 5 Q 3 1 1 0
## 7 1 2 15 21 28 11868 5 Q 3 1 1 0
## 8 1 2 15 22 28 11899 5 Q 3 1 1 0
## 9 1 2 15 23 28 11929 5 Q 3 1 1 0
## 10 1 2 15 24 28 11958 5 Q 3 1 1 0
## # … with 147 more rows, 1 more variable: Clubs <dbl>, and abbreviated variable
## # name ¹Diamonds# Summarize hand types and suits
hn3PlusWild %>% count(nWild, Spades, Hearts, Diamonds, Clubs)## # A tibble: 4 × 6
## nWild Spades Hearts Diamonds Clubs n
## <dbl> <dbl> <dbl> <dbl> <dbl> <int>
## 1 3 1 1 0 0 78
## 2 3 2 0 0 0 66
## 3 4 1 0 0 0 12
## 4 5 NA NA NA NA 1hn3PlusWild %>% count(nWild, qual, wType)## # A tibble: 7 × 4
## nWild qual wType n
## <dbl> <chr> <dbl> <int>
## 1 3 Q 2 10
## 2 3 Q 3 12
## 3 3 Q 4 31
## 4 3 Q 5 91
## 5 4 Q 2 5
## 6 4 Q 3 7
## 7 5 Q 1 1hn3PlusWild %>% count(nWild, qual, wType, Spades, Hearts, Diamonds, Clubs) %>% print(n=30)## # A tibble: 8 × 8
## nWild qual wType Spades Hearts Diamonds Clubs n
## <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <int>
## 1 3 Q 2 2 0 0 0 10
## 2 3 Q 3 1 1 0 0 12
## 3 3 Q 4 2 0 0 0 31
## 4 3 Q 5 1 1 0 0 66
## 5 3 Q 5 2 0 0 0 25
## 6 4 Q 2 1 0 0 0 5
## 7 4 Q 3 1 0 0 0 7
## 8 5 Q 1 NA NA NA NA 1# Run for all non-duplicate hands of type 10 (two pair) or better with no wild, sequence j
runHandSequence(handNums=hn3PlusWild$handNum, rdsName="ICGA_v001_3Pluswild", skipIfExists=TRUE, saveFile=TRUE)## user system elapsed
## 74.81 16.29 92.00The non-duplicated hands are consolidated to a single file:
# Mapping file for src number to name
srcNumName <- c(paste0("seq2", letters[c(1:8, 10)]), "1wild", "2wild", "3pluswild") %>%
purrr::set_names(as.character(1:12))
fullHandProbs <- readFromRDS("ICGA_v001_seq2a") %>%
bind_rows(readFromRDS("ICGA_v001_seq2b"),
readFromRDS("ICGA_v001_seq2c"),
readFromRDS("ICGA_v001_seq2d"),
readFromRDS("ICGA_v001_seq2e"),
readFromRDS("ICGA_v001_seq2f"),
readFromRDS("ICGA_v001_seq2g"),
readFromRDS("ICGA_v001_seq2h"),
readFromRDS("ICGA_v001_seq2j"),
readFromRDS("ICGA_v001_1wild"),
readFromRDS("ICGA_v001_2wild"),
readFromRDS("ICGA_v001_3Pluswild"),
.id="src"
) %>%
mutate(srcName=srcNumName[src],
hndType=case_when(handNum %in% hn2111$handNum ~ "0 wild (2-1-1-1)",
handNum %in% hn221$handNum ~ "0 wild (2-2-1)",
handNum %in% hn311$handNum ~ "0 wild (3-1-1)",
handNum %in% (nPerSuit %>% filter(Spades==3 & Hearts==2) %>% pull(handNum)) ~
"0 wild (3-2)",
handNum %in% (nPerSuit %>% filter(Spades==4 & Hearts==1) %>% pull(handNum)) ~
"0 wild (4-1)",
handNum %in% (nPerSuit %>% filter(Spades==5 & Hearts==0) %>% pull(handNum)) ~
"0 wild (5)",
handNum %in% hn1111$handNum ~ "1 wild (1-1-1-1)",
handNum %in% hn211$handNum ~ "1 wild (2-1-1)",
handNum %in% hn22$handNum ~ "1 wild (2-2)",
handNum %in% (nPerSuit %>%
filter(Spades==3 & Hearts==1 & Diamonds==0 & Clubs==0) %>%
pull(handNum)
) ~ "1 wild (3-1)",
handNum %in% (nPerSuit %>%
filter(Spades==4 & Hearts==0 & Diamonds==0 & Clubs==0) %>%
pull(handNum)
) ~ "1 wild (4)",
handNum %in% hn111$handNum ~ "2 wild (1-1-1)",
handNum %in% (nPerSuit %>%
filter(Spades==2 & Hearts==1 & Diamonds==0 & Clubs==0) %>%
pull(handNum)
) ~ "2 wild (2-1)",
handNum %in% (nPerSuit %>%
filter(Spades==3 & Hearts==0 & Diamonds==0 & Clubs==0) %>%
pull(handNum)
) ~ "2 wild (3)",
handNum %in% hn11$handNum ~ "3 wild (1-1)",
handNum %in% (nPerSuit %>%
filter(Spades==2 & Hearts==0 & Diamonds==0 & Clubs==0) %>%
pull(handNum)
) ~ "3 wild (2)",
handNum %in% (nPerSuit %>%
filter(Spades==1 & Hearts==0 & Diamonds==0 & Clubs==0) %>%
pull(handNum)
) ~ "4 wild (1)",
TRUE~"No suits"
)
)
fullHandProbs## # A tibble: 102,360 × 19
## src pLQ pLN pTQ pTN pWQ pWN n pWNoTie rank type
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1 1 0.736 0.0991 0 0.000142 0 0.165 1712304 0.165 4708 99
## 2 1 0.736 0.0989 0 0.000142 0 0.165 1712304 0.165 4707 99
## 3 1 0.736 0.0987 0 0.000142 0 0.166 1712304 0.166 4706 99
## 4 1 0.736 0.0985 0 0.000142 0 0.166 1712304 0.166 4705 99
## 5 1 0.736 0.0979 0 0.000142 0 0.166 1712304 0.166 4703 99
## 6 1 0.736 0.0977 0 0.000142 0 0.167 1712304 0.167 4702 99
## 7 1 0.735 0.0976 0 0.000142 0 0.167 1712304 0.167 4701 99
## 8 1 0.735 0.0971 0 0.000142 0 0.167 1712304 0.167 4699 99
## 9 1 0.735 0.0969 0 0.000142 0 0.168 1712304 0.168 4698 99
## 10 1 0.735 0.0964 0 0.000142 0 0.168 1712304 0.168 4696 99
## # … with 102,350 more rows, and 8 more variables: handNum <int>, betPlay <dbl>,
## # evAnte <dbl>, evPlay <dbl>, evBlind <dbl>, evAll <dbl>, srcName <chr>,
## # hndType <chr>fullHandProbs %>% count(srcName)## # A tibble: 12 × 2
## srcName n
## <chr> <int>
## 1 1wild 11859
## 2 2wild 1376
## 3 3pluswild 157
## 4 seq2a 10528
## 5 seq2b 11602
## 6 seq2c 10710
## 7 seq2d 6360
## 8 seq2e 9570
## 9 seq2f 11190
## 10 seq2g 11350
## 11 seq2h 7490
## 12 seq2j 10168fullHandProbs %>% count(hndType)## # A tibble: 18 × 2
## hndType n
## <chr> <int>
## 1 0 wild (2-1-1-1) 24024
## 2 0 wild (2-2-1) 26532
## 3 0 wild (3-1-1) 17160
## 4 0 wild (3-2) 14520
## 5 0 wild (4-1) 5940
## 6 0 wild (5) 792
## 7 1 wild (1-1-1-1) 1365
## 8 1 wild (2-1-1) 5148
## 9 1 wild (2-2) 2211
## 10 1 wild (3-1) 2640
## 11 1 wild (4) 495
## 12 2 wild (1-1-1) 364
## 13 2 wild (2-1) 792
## 14 2 wild (3) 220
## 15 3 wild (1-1) 78
## 16 3 wild (2) 66
## 17 4 wild (1) 12
## 18 No suits 1fullHandProbs %>%
count(hndType, srcName) %>%
pivot_wider(id_cols="hndType", names_from="srcName", values_from="n", values_fill=0)## # A tibble: 18 × 13
## hndType seq2a seq2b seq2c seq2d seq2e seq2f seq2g seq2h seq2j `1wild` `2wild`
## <chr> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
## 1 0 wild… 1316 2269 2491 1764 1980 3420 3780 2700 4304 0 0
## 2 0 wild… 3948 1908 2798 3106 3465 1851 3094 3470 2892 0 0
## 3 0 wild… 1974 2901 2274 691 1980 2916 2304 720 1400 0 0
## 4 0 wild… 1974 2901 2274 691 1485 2187 1728 540 740 0 0
## 5 0 wild… 1316 1623 873 108 660 816 444 60 40 0 0
## 6 0 wild… 0 0 0 0 0 0 0 0 792 0 0
## 7 1 wild… 0 0 0 0 0 0 0 0 0 1365 0
## 8 1 wild… 0 0 0 0 0 0 0 0 0 5148 0
## 9 1 wild… 0 0 0 0 0 0 0 0 0 2211 0
## 10 1 wild… 0 0 0 0 0 0 0 0 0 2640 0
## 11 1 wild… 0 0 0 0 0 0 0 0 0 495 0
## 12 2 wild… 0 0 0 0 0 0 0 0 0 0 364
## 13 2 wild… 0 0 0 0 0 0 0 0 0 0 792
## 14 2 wild… 0 0 0 0 0 0 0 0 0 0 220
## 15 3 wild… 0 0 0 0 0 0 0 0 0 0 0
## 16 3 wild… 0 0 0 0 0 0 0 0 0 0 0
## 17 4 wild… 0 0 0 0 0 0 0 0 0 0 0
## 18 No sui… 0 0 0 0 0 0 0 0 0 0 0
## # … with 1 more variable: `3pluswild` <int>Probabilities of winning (excluding ties from denominator) are calculated by rank:
fullHandProbs %>%
mutate(useType=ifelse(type<11, "1. Two pair or better", ifelse(type==11, "2. Pair", "3. No Pair")),
hasWild=ifelse(str_detect(hndType, "0 wild"), "0 wild", "1+ wild")
) %>%
ggplot(aes(x=factor(rank), y=pWNoTie)) +
geom_boxplot(aes(color=hasWild)) +
facet_wrap(~useType, scales="free_x") +
theme(axis.text.x=element_blank(), axis.ticks.x=element_blank()) +
labs(x="Hand rank (best on left)", y="Win probability (excluding ties)", title="Win probability by rank") +
geom_hline(yintercept=c(0, 0.25, 0.5, 1), lty=2)
Hands with no pair are assessed for win probability:
# Include ranks of cards from sortedHandRanks
fullHandProbsData <- fullHandProbs %>%
left_join(select(sortedHandRanks, -chgRank, -rank, -qual), by=c("handNum"))
fullHandProbsData## # A tibble: 102,360 × 26
## src pLQ pLN pTQ pTN pWQ pWN n pWNoTie rank type
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1 1 0.736 0.0991 0 0.000142 0 0.165 1712304 0.165 4708 99
## 2 1 0.736 0.0989 0 0.000142 0 0.165 1712304 0.165 4707 99
## 3 1 0.736 0.0987 0 0.000142 0 0.166 1712304 0.166 4706 99
## 4 1 0.736 0.0985 0 0.000142 0 0.166 1712304 0.166 4705 99
## 5 1 0.736 0.0979 0 0.000142 0 0.166 1712304 0.166 4703 99
## 6 1 0.736 0.0977 0 0.000142 0 0.167 1712304 0.167 4702 99
## 7 1 0.735 0.0976 0 0.000142 0 0.167 1712304 0.167 4701 99
## 8 1 0.735 0.0971 0 0.000142 0 0.167 1712304 0.167 4699 99
## 9 1 0.735 0.0969 0 0.000142 0 0.168 1712304 0.168 4698 99
## 10 1 0.735 0.0964 0 0.000142 0 0.168 1712304 0.168 4696 99
## # … with 102,350 more rows, and 15 more variables: handNum <int>,
## # betPlay <dbl>, evAnte <dbl>, evPlay <dbl>, evBlind <dbl>, evAll <dbl>,
## # srcName <chr>, hndType <chr>, wType <dbl>, tb1 <dbl>, tb2 <dbl>, tb3 <dbl>,
## # tb4 <dbl>, tb5 <dbl>, nWild <dbl># Convert 14, 13, 12, 11, 10 to A, K, Q, J, T
numberToCard <- function(x)
case_when(x==14 ~ "A", x==13 ~ "K", x==12 ~ "Q", x==11 ~ "J", x==10 ~ "T", TRUE ~ as.character(x))
# Plot for ranks of non-pair hands
fullHandProbsData %>%
filter(type==99) %>%
mutate(ranks=paste0(numberToCard(tb1), numberToCard(tb2))) %>%
group_by(tb1, tb2, ranks) %>%
summarize(across(pWNoTie, .fns=list(max=max, med=median, min=min)), .groups="drop") %>%
arrange(desc(tb1), desc(tb2)) %>%
mutate(ranks=factor(ranks, levels=ranks)) %>%
ggplot(aes(x=ranks)) +
geom_errorbar(aes(ymin=pWNoTie_min, ymax=pWNoTie_max), width=0.5) +
geom_point(aes(y=pWNoTie_med)) +
labs(x=NULL,
y="Win probability (ties excluded)",
title="Win probability for non-paired hands",
subtitle="Median and max/min range"
) +
geom_hline(yintercept=c(0, 0.25), lty=2)
# Plot for ranks of AK hands
fullHandProbsData %>%
filter(type==99, tb1==14, tb2==13) %>%
mutate(ranks=paste0(numberToCard(tb3), numberToCard(tb4))) %>%
group_by(tb3, tb4, ranks) %>%
summarize(across(pWNoTie, .fns=list(max=max, med=median, min=min)), .groups="drop") %>%
arrange(desc(tb3), desc(tb4)) %>%
mutate(ranks=factor(ranks, levels=ranks)) %>%
ggplot(aes(x=ranks)) +
geom_errorbar(aes(ymin=pWNoTie_min, ymax=pWNoTie_max), width=0.5) +
geom_point(aes(y=pWNoTie_med)) +
labs(x=NULL,
y="Win probability (ties excluded)",
title="Win probability for non-paired hands of type AK based on third and fourth ranks",
subtitle="Median and max/min range"
) +
geom_hline(yintercept=c(0, 0.25), lty=2)
Hands without a pair are largely monotonic, with better ranks corresponding to higher win probabilities. The cutoff for 25% win probability is around AKJ7x
Hands with one pair are assessed for win probability:
# Plot for ranks of one-pair hands
fullHandProbsData %>%
filter(type==11) %>%
mutate(ranks=paste0(numberToCard(tb1)),
nOver=(tb3>tb1)+(tb4>tb1)+(tb5>tb1),
colorHand=ifelse(nWild==1, "wild", paste0(as.character(nOver), " overs"))
) %>%
group_by(ranks, tb1, nOver, nWild, colorHand) %>%
summarize(across(pWNoTie, .fns=list(max=max, med=median, min=min)), .groups="drop") %>%
arrange(desc(tb1)) %>%
mutate(ranks=factor(ranks, levels=unique(ranks))) %>%
ggplot(aes(color=colorHand)) +
geom_errorbar(aes(x=as.numeric(ranks) + ifelse(colorHand=="wild", -0.2, -.1*(nOver-2)),
ymin=pWNoTie_min,
ymax=pWNoTie_max
),
width=0.1
) +
geom_point(aes(x=as.numeric(ranks) + ifelse(colorHand=="wild", -0.2, -.1*(nOver-2)), y=pWNoTie_med)) +
labs(x=NULL,
y="Win probability (ties excluded)",
title="Win probability for paired hands",
subtitle="Median and max/min range"
) +
geom_hline(yintercept=c(0, 0.25, 0.5, 1), lty=2) +
scale_x_continuous(breaks=1:12, labels=c("A", "K", "Q", "J", "T", 9:3)) +
scale_color_discrete("Composition")
# Plot for ranks of one-pair JJ hands
fullHandProbsData %>%
filter(type==11, tb1==11) %>%
mutate(kicker=paste0(numberToCard(tb3)),
nOver=(tb3>tb1)+(tb4>tb1)+(tb5>tb1),
colorHand=ifelse(nWild==1, "wild", paste0(as.character(nOver), " overs"))
) %>%
group_by(kicker, tb3, nOver, nWild, colorHand) %>%
summarize(across(pWNoTie, .fns=list(max=max, med=median, min=min)), .groups="drop") %>%
arrange(desc(tb3)) %>%
mutate(kicker=factor(kicker, levels=unique(kicker))) %>%
ggplot(aes(color=colorHand)) +
geom_errorbar(aes(x=as.numeric(kicker) + ifelse(colorHand=="wild", -0.2, -.1*(nOver-2)),
ymin=pWNoTie_min,
ymax=pWNoTie_max
),
width=0.1
) +
geom_point(aes(x=as.numeric(kicker) + ifelse(colorHand=="wild", -0.2, -.1*(nOver-2)), y=pWNoTie_med)) +
labs(x="Kicker for JJ hand",
y="Win probability (ties excluded)",
title="Win probability for JJ paired hands",
subtitle="Median and max/min range"
) +
geom_hline(yintercept=c(0.5), lty=2) +
scale_x_continuous(breaks=1:9, labels=c("A", "K", "Q", "T", 9:5)) +
scale_color_discrete("Composition")
Hands with a pair are not strictly monotonic, and having a wild card or extra over-cards is more valuable in some cases than a higher kicker
Hands with two pairs are assessed for win probability:
# Plot for ranks of two-pair hands
fullHandProbsData %>%
filter(type==10) %>%
mutate(ranks=paste0(numberToCard(tb1), numberToCard(tb3)),
kickerType=case_when(tb5>tb1~"above", tb5<tb3~"below", TRUE~"between")
) %>%
group_by(tb1, tb3, ranks, kickerType) %>%
summarize(across(pWNoTie, .fns=list(max=max, med=median, min=min)), .groups="drop") %>%
arrange(desc(tb1), desc(tb3)) %>%
mutate(ranks=factor(ranks, levels=unique(ranks))) %>%
ggplot(aes(x=ranks)) +
geom_errorbar(aes(ymin=pWNoTie_min, ymax=pWNoTie_max, color=kickerType), width=0.5) +
geom_point(aes(y=pWNoTie_med, color=kickerType)) +
geom_line(aes(y=pWNoTie_med, group=kickerType, color=kickerType)) +
labs(x="Two-pair ranks",
y="Win probability (ties excluded)",
title="Win probability for two-pair hands",
subtitle="Median and max/min range"
) +
geom_hline(yintercept=c(0.75), lty=2) +
theme(axis.text.x=element_text(size=7), legend.position="bottom") +
scale_color_discrete("Kicker rank")
Hands with two pair are not strictly monotonic, and having higher ranks and more combinations that block straights are generally both valuable. There is little variation in win probability from best to worst two-pair hand, since it is a relatively rare hand type given the prevalence of wild cards
Hands with three-of-a-kind, straight, flush, and full house are assessed for win probability:
# Plot for three-of-a-kind, straight, flush, full house
fullHandProbsData %>%
filter(type %in% c(6, 7, 8, 9)) %>%
mutate(ranks=paste0(numberToCard(tb1), case_when(type==9~"\ntrip",
type==8~"\nlow\nstraight",
type==7~"\nflush", type==6~"\nfull")
),
nWild=as.character(nWild)
) %>%
group_by(type, tb1, ranks, nWild) %>%
summarize(across(pWNoTie, .fns=list(max=max, med=median, min=min)), .groups="drop") %>%
arrange(type, desc(tb1)) %>%
mutate(ranks=ifelse(type==8 & tb1==2, "A\nlow\nstraight", ranks),
ranks=factor(ranks, levels=unique(ranks))
) %>%
ggplot(aes(x=ranks)) +
geom_errorbar(aes(ymin=pWNoTie_min, ymax=pWNoTie_max, color=nWild), width=0.2) +
geom_point(aes(y=pWNoTie_med, color=nWild)) +
labs(x="Hand type",
y="Win probability (ties excluded)",
title="Win probability for three-of-a-kind, straight, flush, full house",
subtitle="Median and max/min range"
) +
geom_hline(yintercept=c(0.75, 1), lty=2) +
theme(axis.text.x=element_text(size=7)) +
scale_color_discrete("# wilds")
Win probability increases significantly as the rank and/or number of wilds in a three-of-a-kind increases. A similar but smaller magnitude impact is observed for straights. Flushes and full houses are powerful hands with win probabilities that are mostly independent of rank but modestly increased by possession of a wild (with flushes, a wild always makes the flush Ace-high, so rank and wilds are particularly associated in these hands)
Hands with four-of-a-kind or better are assessed for win probability:
# Plot for five wild, four-of-a-kind, straight flush, five-of-a-kind, royal flush
fullHandProbsData %>%
filter(type %in% c(1, 2, 3, 4, 5)) %>%
mutate(ranks=ifelse(type>2,
paste0(numberToCard(tb1),
case_when(type==5~"\nquad", type==4~"\nlow\nSF", type==3~"\nquint")
),
ifelse(type==2, "RF", "5W")
),
nWild=as.character(nWild)
) %>%
group_by(type, tb1, ranks, nWild) %>%
summarize(across(pWNoTie, .fns=list(max=max, med=median, min=min)), .groups="drop") %>%
arrange(type, desc(tb1)) %>%
mutate(ranks=factor(ranks, levels=unique(ranks))) %>%
ggplot(aes(x=ranks)) +
geom_errorbar(aes(ymin=pWNoTie_min, ymax=pWNoTie_max, color=nWild), width=0.2) +
geom_point(aes(y=pWNoTie_med, color=nWild)) +
labs(x="Hand type",
y="Win probability (ties excluded)",
title="Win probability for four-of-a-kind or better",
subtitle="Median and max/min range"
) +
geom_hline(yintercept=c(0.975, 1), lty=2) +
theme(axis.text.x=element_text(size=7)) +
scale_color_discrete("# wilds")
Very strong hands almost always win, though Win probability increases slightly as the rank and/or number of wilds in a four-of-a-kind, straight flush, or five-of-a-kind increases
Hands are arranged from highest to lowest win probability, with gaps explored:
# Create delta as lowest gap between preceeding and succeeding hand
fullHandDelta <- fullHandProbsData %>%
mutate(pWpL=pWQ+pWN-pLQ-pLN) %>%
arrange(pWpL) %>%
mutate(delta=case_when(row_number()==1 ~ lead(pWpL)-pWpL,
row_number()==n() ~ pWpL-lag(pWpL),
TRUE ~ pmin(lead(pWpL)-pWpL, pWpL-lag(pWpL))
)
) %>%
select(delta, pWpL, everything())
fullHandDelta## # A tibble: 102,360 × 28
## delta pWpL src pLQ pLN pTQ pTN pWQ pWN n pWNoTie rank
## <dbl> <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 0 -1.00 2 0.736 0.264 0 0.000141 0 0 1.71e6 0 5163
## 2 0 -1.00 2 0.736 0.264 0 0.000141 0 0 1.71e6 0 5163
## 3 0 -1.00 2 0.736 0.264 0 0.000141 0 0 1.71e6 0 5163
## 4 0 -1.00 2 0.736 0.264 0 0.000141 0 0 1.71e6 0 5163
## 5 0 -1.00 2 0.736 0.264 0 0.000141 0 0 1.71e6 0 5163
## 6 0 -1.00 2 0.736 0.264 0 0.000141 0 0 1.71e6 0 5163
## 7 0 -1.00 2 0.736 0.264 0 0.000141 0 0 1.71e6 0 5163
## 8 0 -1.00 2 0.736 0.264 0 0.000141 0 0 1.71e6 0 5163
## 9 0 -1.00 2 0.736 0.264 0 0.000141 0 0 1.71e6 0 5163
## 10 0 -1.00 2 0.736 0.264 0 0.000141 0 0 1.71e6 0 5163
## # … with 102,350 more rows, and 16 more variables: type <dbl>, handNum <int>,
## # betPlay <dbl>, evAnte <dbl>, evPlay <dbl>, evBlind <dbl>, evAll <dbl>,
## # srcName <chr>, hndType <chr>, wType <dbl>, tb1 <dbl>, tb2 <dbl>, tb3 <dbl>,
## # tb4 <dbl>, tb5 <dbl>, nWild <dbl># Summary of the delta statistic
summary(fullHandDelta %>% mutate(delta=1000000*delta) %>% pull(delta))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 0.000 1.168 4.592 3.504 399.462# Proportion of hands with zero delta
fullHandDelta %>%
mutate(noGap = (1000000*delta < 0.1)) %>%
group_by(rank, type, nWild) %>%
summarize(n=n(), pct=mean(noGap), .groups="drop") %>%
group_by(type, nWild) %>%
summarize(pctNoGap=sum(pct*n)/sum(n), n=sum(n), .groups="drop") %>%
ggplot(aes(x=factor(type), y=pctNoGap)) +
geom_text(aes(color=factor(nWild), label=round(pctNoGap, 3)), size=2.5) +
labs(x="Hand type",
y="Percent tied with previous and/or next",
title="Hands of tied value in fullHandProbData by hand type"
) +
scale_color_discrete("# Wild")
# Number of hands with zero delta
fullHandDelta %>%
mutate(noGap = (1000000*delta < 0.1)) %>%
count(type, nWild, noGap) %>%
ggplot(aes(x=factor(type), y=n/1000)) +
geom_col(aes(fill=factor(noGap))) +
labs(x="Hand type",
y="Number of hands (000)",
title="Hands of tied value in fullHandProbData by hand type",
subtitle="Facetted by number of wilds"
) +
scale_fill_discrete("No Gap?") +
facet_wrap(~nWild, scales="free_y") +
theme(legend.position = "bottom")
Even with the de-duplication process, many hands get the identical results as the previous or next hand. The majority of these cases are in hands with no wild and zero or one pair
Are hands with zero pairs monotonic based on rank?
# Get range of EV of each rank of hands with no pair
noPairEV <- fullHandProbsData %>%
filter(type==99) %>%
mutate(evIfPlay=3*(pWQ+pWN) + 2*(pTQ+pTN) - (pLQ+pLN)) %>%
group_by(rank, type, nWild, tb1, tb2, tb3, tb4, tb5) %>%
summarize(n=n(), minEV=min(evIfPlay), meanEV=mean(evIfPlay), maxEV=max(evIfPlay), .groups="drop")
noPairEV## # A tibble: 784 × 12
## rank type nWild tb1 tb2 tb3 tb4 tb5 n minEV meanEV maxEV
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1 4380 99 0 14 13 12 11 9 50 0.0569 0.0575 0.0580
## 2 4381 99 0 14 13 12 11 8 50 0.0565 0.0571 0.0576
## 3 4382 99 0 14 13 12 11 7 50 0.0560 0.0566 0.0571
## 4 4383 99 0 14 13 12 11 6 50 0.0548 0.0554 0.0559
## 5 4384 99 0 14 13 12 11 5 50 0.0534 0.0541 0.0545
## 6 4385 99 0 14 13 12 11 4 50 0.0521 0.0527 0.0532
## 7 4386 99 0 14 13 12 11 3 50 0.0507 0.0514 0.0518
## 8 4387 99 0 14 13 12 10 9 50 0.0506 0.0512 0.0516
## 9 4388 99 0 14 13 12 10 8 50 0.0501 0.0508 0.0512
## 10 4389 99 0 14 13 12 10 7 50 0.0497 0.0503 0.0507
## # … with 774 more rows# Plot magnitude of EV range
noPairEV %>%
ggplot(aes(x=(maxEV-minEV))) +
geom_histogram(fill="lightblue", bins=100) +
geom_vline(xintercept=0.001, lty=2) +
labs(x="Range of EV within same rank",
y="Number of ranks",
title="Range of EV for hands of same rank",
subtitle="Hands with no pair, no wild",
caption="Dotted line at 0.001 (0.1% range of EV)"
)
# Plot ranges of EV for hands of type AKQxx
noPairEV %>%
filter(tb2==13, tb3>=11) %>%
mutate(ranks=paste0("AK",
case_when(tb3==12~"Q", tb3==11~"J", tb3==10 ~ "T", TRUE~as.character(tb3)),
case_when(tb4==11~"J", tb4==10~"T", TRUE~as.character(tb4)),
case_when(tb5==11~"J", tb5==10~"T", TRUE~as.character(tb5))
),
rank45=400*tb3+20*tb4+tb5
) %>%
ggplot(aes(x=fct_reorder(ranks, rank45))) +
geom_point(aes(y=meanEV)) +
geom_errorbar(aes(ymin=minEV, ymax=maxEV)) +
coord_flip() +
labs(x="EV of play vs. fold", y=NULL, title="EV of play vs. fold for hands of type AK[Q|J]xx") +
facet_wrap(~tb3, scales="free")
There are a few cases where hands are not monotonic in mean EV when sorted by rank. This typically occurs around a cut point where a lower ranked hand blocks more straights (e.g., from AKQT3 to AKQ98 or from AKQ93 to AKQ87). In addition, error bars frequently overlap between hands, for example, some AKQJ8 being better than some AKQJ9. The ranges are extremely small (at most just above 0.1% EV), so impact is likely very modest
Hands of type AKQJ9 and AKQJ8 are explored:
tmpSubset <- fullHandProbsData %>%
filter(type==99) %>%
mutate(evIfPlay=3*(pWQ+pWN) + 2*(pTQ+pTN) - (pLQ+pLN)) %>%
filter(tb4==11, tb5 >= 8)
tmpSubset## # A tibble: 100 × 27
## src pLQ pLN pTQ pTN pWQ pWN n pWNoTie rank type
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1 1 0.735 0.000189 0 0.000142 0 0.264 1712304 0.264 4381 99
## 2 1 0.735 0 0 0.000142 0 0.264 1712304 0.264 4380 99
## 3 1 0.735 0.000189 0 0.000142 0 0.264 1712304 0.264 4381 99
## 4 1 0.735 0 0 0.000142 0 0.264 1712304 0.264 4380 99
## 5 1 0.735 0.000189 0 0.000142 0 0.264 1712304 0.264 4381 99
## 6 1 0.735 0 0 0.000142 0 0.264 1712304 0.264 4380 99
## 7 1 0.735 0.000189 0 0.000142 0 0.264 1712304 0.264 4381 99
## 8 1 0.735 0 0 0.000142 0 0.264 1712304 0.264 4380 99
## 9 1 0.735 0.000189 0 0.000141 0 0.264 1712304 0.264 4381 99
## 10 1 0.735 0.000189 0 0.000141 0 0.264 1712304 0.264 4381 99
## # … with 90 more rows, and 16 more variables: handNum <int>, betPlay <dbl>,
## # evAnte <dbl>, evPlay <dbl>, evBlind <dbl>, evAll <dbl>, srcName <chr>,
## # hndType <chr>, wType <dbl>, tb1 <dbl>, tb2 <dbl>, tb3 <dbl>, tb4 <dbl>,
## # tb5 <dbl>, nWild <dbl>, evIfPlay <dbl># Plot for EV of playing hands
tmpSubset %>%
arrange(evIfPlay) %>%
mutate(rn=row_number(), ht=case_when(rank==4381~"AKQJ8", rank==4380~"AKQJ9", TRUE~"Error")) %>%
ggplot(aes(x=rn, y=evIfPlay)) +
geom_point(aes(color=ht)) +
scale_color_discrete("Hand Type") +
labs(x=NULL, y="EV if played", title="Zero-pair hands of type AKQxx and AKJxx sorted by EV")
# Plot for EV of playing hands
tmpSubset %>%
arrange(evIfPlay) %>%
left_join(nPerSuit, by="handNum") %>%
mutate(rn=row_number(),
ht=case_when(rank==4381~"AKQJ8", rank==4380~"AKQJ9", TRUE~"Error"),
suits=paste(Spades, Hearts, Diamonds, Clubs, sep="-")
) %>%
ggplot(aes(x=rn, y=evIfPlay)) +
geom_point(aes(color=suits)) +
scale_color_discrete("Suits") +
labs(x=NULL, y="EV if played", title="Zero-pair hands of type AKQxx and AKJxx sorted by EV") +
facet_wrap(~ht)
Within each set of ranks, there are quanta based on the distribution of suits (2-1-1-1 being the most favorable to the player, 4-1-0-0 being the least). Within each quanta, there are some very minor distinctions in EV as well